home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Speccy ClassiX 1998
/
Speccy ClassiX 98.iso
/
amiga_system
/
the_aminet
/
comm
/
bbs
/
bbbbs85.lha
/
rexx
/
BBBBS.baud
< prev
next >
Wrap
Text File
|
1995-06-03
|
146KB
|
5,523 lines
/* $VER: BBBBS.baud 8.5 (3.6.95)
BBBBS.baud 8.5 ⌐ 1990-95 Richard Lee Stockton 3 Jun 95 2:05PM
- FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -
BBBBS.baud. A full-featured BBS in ARexx for Baudbandit
based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit!
See BBBBS.guide and rexx/bbsLOCAL.rexx for install info
*/
saypath='SYS:Utilities/Say'
/* If QuickSortPort not found then try to run setup.rexx */
IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
IF ~SHOW('P','QuickSortPort') THEN EXIT 666
IF SHOW('P','BBBBS') THEN
DO
SAY 'BBBBS is already running!'
EXIT 0
END
CALL OPENPORT('BBBBS')
RESET:
CALL SETCLIP('BBS_RESET')
copyright.=''
copyright.1=STRIP(SOURCELINE(2))
copyright.2='
Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009'
copyright.3='
ARexx portions of this software copyright 1990-95 Richard Lee Stockton'
copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'
CALL SETCLIP('BBS_version',copyright.1)
CALL SETCLIP('BBS_localfiles')
CALL SETCLIP('BBS_localusers')
CALL SETCLIP('BBS_interpret')
CALL SETCLIP('BBS_FULLCALL')
CALL SETCLIP('BBS_MESSAGE')
CALL SETCLIP('BBS_BROWSE')
CALL SETCLIP('BBS_MSGS')
CALL SETCLIP('BBS_QUIT')
/* try to trap everything */
OPTIONS RESULTS
OPTIONS FAILAT 999999
NUMERIC DIGITS 14
SIGNAL ON HALT
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E
PARSE VERSION . . cpu .
cpu=RIGHT(cpu,2)/10
IF cpu<1 THEN cpu=1
Status Vers
BB_VERS=RESULT
bm=50
IF RIGHT(BB_VERS,4)>1.59 THEN bm=25
dcd
IF RC=0 THEN Send 'ATH1\r'
bbsprefs.=0 /* start with all prefs OFF */
namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
alpha.=''
logonflag=1
emailonline=-1
CALL zerovars()
name=''
CR='0D'x
LF='0A'x
lineup='1B'x'M'
lm='Loading Module...'lineup||CR
SAY CR
SAY CENTER(copyright.1,75)||CR
CALL PRAGMA('W','N')
CALL config()
IF bbsprefs.15~=0 THEN
CALL send2log('===== BBBBS started' DATE('W') DATE() TIME('C') '=====')
IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'
SAY CENTER(copyright.2,75)||CR
/* open printer? */
IF bbsprefs.3 THEN
DO
IF ~OPEN(p,'PRT:','W') THEN
DO
CALL send2log('failed to open printer.')
bbsprefs.3=0
END
END
/* CALL PRAGMA('W','W') <-- UN-COMMENT THIS LINE TO ENABLE REQUESTERS */
CALL colors(1)
Capture OFF
Timeout 120
SAY CENTER(copyright.3,75)||CR
excuses.=''
courtesy=''
courtesyflag=0
SAY CENTER(copyright.4,75)||CR
SAY CR
SAY CR
SAY CENTER('Setting up, please wait...',75)||CR
SAY CR
msg.=''
IF readopen(bbspath'Lists/Conferences') THEN
DO
DO i=1
line=READLN(f)
IF line='END' THEN BREAK
IF EOF(f) THEN BREAK
num=WORD(line,1)
IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
END
CALL CLOSE(f)
END
dirs.=''
IF readopen(bbspath'Lists/Libraries') THEN
DO
DO i=1
line=READLN(f)
IF line='END' | EOF(f) THEN LEAVE i
num=WORD(line,1)
IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
END
CALL CLOSE(f)
END
users=0
CALL sortuserlist()
SAY CR
SAY ' The larger the BBS gets, the longer it takes to setup...'CR
CALL loadfiles()
dcd
IF RC~=0 & bbsprefs.15>0 THEN
DO
SAY CR
SAY ' If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR
END
SAY CR
CALL set_grand()
CALL loadalpha(1)
dcd
IF RC=0 THEN
DO
logonflag=0
SIGNAL DONE
END
LOGON:
CALL checkdcd()
bps=0
SetMark 'CONNECT'
IF RC=1 THEN
DO
GetLine
connectline=RESULT
PARSE VAR connectline 'CONNECT'bps
CALL STRIP(bps)
DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
END
bps=LEFT(bps,i-1)
END
IF bps<300 | bps>38400 THEN
DO
SetMark 'CARRIER'
IF RC=1 THEN
DO
GetLine
connectline=RESULT
PARSE VAR connectline 'CARRIER'bps
CALL STRIP(bps)
END
ELSE bps='000 '
END
DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
END
bps=LEFT(bps,i-1)
SIGNAL ON BREAK_C
SIGNAL OFF BREAK_E
REMOTE ON
TimeOut 120
IF bps<300 THEN bps=getbaudrate()
IF bps<300 THEN SIGNAL DONE
bps=bps%1
IF logonflag=0 THEN
DO
logonflag=1
DO i=1 TO 7
SAY ' 'CR
END
DO i=1 TO 4
SAY CENTER(copyright.i,75)||CR
END
CALL sound('LOGON')
CALL DELAY(150)
SAY CR
SAY CR
SAY CR
END
colorflag=1
CALL colors(1)
IF alpha.0='' THEN CALL loadalpha(1)
CALL TIME('R')
/** Identify (title) message */
IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
DO
nonstop=1
CALL showtext(bbspath'BBS_TEXT/HELLO' 0)
nonstop=0
END
SAY CR
SAY 'Running on' BB_VERS 'at' bps 'baud. ' TIME('C') DATE('W') DATE()||CR
Stat 'Z'
CALL checkdcd()
/* Ask for name */
name=''
courtesy=''
Queue CR
DO count=1 TO 3
name=getinput(1 0 'Please enter name: ')
name=cleanstring(1':'name)
IF name='NEW' THEN LEAVE count
IF name~='' THEN
DO
IF EXISTS(bbspath'Users/'name) THEN LEAVE count
IF EXISTS(bbspath'Morgue/'name'.lha') THEN
DO
SAY CR
SAY name 'used to be a member of this BBS.'CR
SAY 'If that is you, and you recall your password, you may resurrect yourself...'CR
IF getinput(1 1 'Resurrect' name'? (Ny) > ')='Y' THEN
DO
dd=WORD(STATEF(bbspath'Morgue/'name'.lha'),5)
dd=DATE(,dd,'I')
SAY 'Resurrecting a dead user. Killed' dd '...'CR
ADDRESS COMMAND 'CD' bbspath'0A'x||'lha x Morgue/'name'.lha'
CALL DELETE(bbspath'Morgue/'name'.lha')
CALL send2log('RESURRECTED:' name 'who was killed' dd)
sortuserflag=1
CALL sound('NEW_USER')
LEAVE count
END
END
IF FIND(exclusion,name)>0 THEN
DO
SAY 'Sorry, that is a reserved name.'CR
name=''
ITERATE count
END
CALL loadcourtesy()
IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
DO
SAY CR
SAY 'Welcome' name'!'CR
SAY 'You will be automatically validated after you enter your user info.'CR
SAY CR
LEAVE count
END
END
IF count<3 THEN
DO
IF STRIP(name)~='' THEN SAY name 'not found. Please try again.'CR
SAY 'New Users enter NEW to apply for validation.'CR
END
END
IF count>3 THEN SIGNAL DONE
CALL TIME('R')
logontime=TIME('C')
line=left(name,16,' ') 'logged in at' time('C') date('W') date() 'at' bps 'baud'
CALL send2log(line)
CALL checkUser()
x=GETCLIP('BBS_FULLCALL')
CALL SETCLIP('BBS_FULLCALL')
IF WORD(x,1)=name & level<sysoplevel THEN
DO
mins=TIME('M')-WORD(x,2)
IF mins<0 THEN mins=mins+1440
IF mins<bbsprefs.26 THEN
DO
SAY CR
SAY bak2'*** Please wait at least' bbsprefs.26 'minutes between calls ***'def||CR
SAY CR
CALL SETCLIP('BBS_FULLCALL',x)
SIGNAL LOGOUT2
END
END
IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
DO
SAY CR
SAY 'Please help us out by entering the following information.'CR
CALL getbirth()
SAY ' Thank you!'CR
END
prevcaller=''
prevcaller=GETCLIP('BBS_lastcaller')
IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller)
city=docity(data.3)
CALL SETCLIP('BBS_lastcaller',name city' 'TIME('C') DATE())
CALL SETCLIP('BBS_level',level)
CALL postuser(0)
Timeout maxidle /* max idle time at prompts */
IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
DO
arg=bbspath'BBS_TEXT/BIRTHDAY'
IF EXISTS(arg) THEN
DO
SAY CR
CALL showtext(arg 1)
END
SAY CR
SAY '*** Happy Birthday,' pen3||data.1||def', and many more! ***'CR
END
SAY CR
/* Get current protocol */
Status Trans
protocol=STRIP(RESULT)
IF bbsLOGON.baud(name level)=1 THEN SIGNAL OUT
CALL checkdcd()
CALL sortlibraries()
CALL sortconferences()
IF FIND(data.8,'QUICK')>0 THEN
DO
logonflag=0
CALL do_quick(0)
logonflag=1
END
/*
Opening Display after logon. Seen by all Users ONCE A DAY. It first
looks for a unique yearly data (ie, WELCOME.0704), then daily data
(ie, WELCOME.Fri), and then a simple, everyday 'WELCOME' datafile.
*/
CALL postfour('Logon Messages')
IF DATE('I')>lastondate THEN
DO
SAY CR
arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
CALL showtext(arg 1)
SAY CR
arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
CALL showtext(arg 1)
SAY CR
arg=bbspath'BBS_TEXT/WELCOME'
CALL showtext(arg 1)
/*
Looks for files in the format BAUD.baudrate, ie "BAUD.2400" will only
be seen by users logging on at 2400 baud.
*/
arg=bbspath'BBS_TEXT/BAUD.'bps
IF EXISTS(arg) THEN
DO
SAY CR
CALL showtext(arg 1)
END
/*
Looks for files in the format LEVEL.low-high, ie "LEVEL.50-80" will only
be seen by users with a level >= 50 and <= 80.
*/
levels.=''
IF FileList(bbspath'BBS_TEXT/LEVEL.*',levels)>0 THEN
DO
DO ui=1 TO levels.0
p=LASTPOS('.',levels.ui)
x=SUBSTR(levels.ui,p+1)
PARSE VAR x lo'-'hi .
IF ~DATATYPE(lo,'W') | ~DATATYPE(hi,'W') THEN ITERATE ui
IF lo>level | hi<level THEN ITERATE ui
DO
SAY CR
CALL showtext(levels.ui 1)
END
END
END
/*
Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
Deletes any that are previous to "today"
*/
untils.=''
IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
DO
CALL QSORT(1,untils.0,untils)
DO ui=1 TO untils.0
IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
ELSE
DO
SAY CR
CALL showtext(untils.ui 1)
END
END
END
DROP levels. untils.
END
IF bbsprefs.1 & ~terseflag THEN
DO
IF doGrin()>3 THEN CALL waiting()
IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
DO
tf=scratch'/TODAY'
IF EXISTS(tf) THEN
DO
finfo=STATEF(tf)
IF WORD(finfo,5)~=DATE('I') THEN
ADDRESS COMMAND 'C:Today091 >'tf
END
ELSE ADDRESS COMMAND 'C:Today091 >'tf
CALL showtext(tf 0)
END
SAY CR
END
IF SHOWDIR(bbspath'Email/'name)~='' THEN CALL readmail(0)
ELSE SAY 'Your mailbox is empty.'CR
IF ~terseflag THEN
DO
IF level>sysoplevel THEN
DO
lstmail=WORD(data.17,3)
IF ~DATATYPE(lstmail,'W') THEN lstmail=0
IF countcheck('Numbers/LastMail' 0)>lstmail THEN
IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
IF level<99 THEN
DO
SAY CR
CALL showtext(bbspath'Email/'sysop'/NEW_FILES' 1)
END
SAY CR
CALL showtext(bbspath'Lists/NEW_USERS' 1)
CALL showtext(bbspath'Lists/CBV_USERS' 1)
END
CALL logonstats()
CALL newinfo()
END
CALL showmarked(1)
CALL setdir(libpath||dirs.1)
logonflag=0
/***** MAIN *****/
IF menu~='ALL' THEN menu='MAIN'
RESTART:
IF name='' | data.20='' | logonflag THEN SIGNAL LOGON /* login was interrupted */
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E
waitchar=''
string=''
opt=''
IF level<1 THEN menu='NEW'
DO WHILE(opt~='G')
go=0
uldlflag=0
DO WHILE(~go)
IF waitchar='' | waitchar='?' THEN
DO
commands='ceghiqrsvwxyz!#,'
IF level>0 THEN commands='abcdefghijlmnoprstuvwxyz!$#&+,.'
IF level>sysoplevel THEN commands=commands'k%^()=;'
IF level=99 THEN commands=commands'@~'
commands=commands'?'
IF menuflag | waitchar='?' | string='?' THEN CALL menus()
ELSE SAY pen3'COMMANDS:'def commands||CR
opt='MENU'
arg=''
CALL postuser(1)
IF level=0 THEN
IF SHOWDIR(bbspath'Email/'name)~='' THEN
DO
SAY 'You have new Email waiting! - Enter E to read your [E]mail'CR
SAY CR
END
END
CALL showtime()
line=''
line=line||bak2' 'TIME('C')' 'def
IF menu='ALL' | menu='FILE' THEN
line=line pen3'FILE_LIBRARY:'plaindir||def
ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
ELSE line=line pen3'MAIN:'def
line=line' 'bbsname
IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
PARSE VAR waitchar string' 'arg
CALL checkdcd()
nonstop=0
string=UPPER(STRIP(string))
IF clr~='' THEN Send clr
IF POS('+++',string)>0 THEN SIGNAL OUT
IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2
IF string='FL' & level>0 THEN
DO
CALL bbsFriends.rexx(name colorflag)
string=''
END
CALL checkalias()
IF LEFT(string,1)='D' THEN
IF DATATYPE(SUBSTR(string,2),'W') THEN arg=SUBSTR(string,2) arg
waitchar=''
warnings=0
IF DATATYPE(string,'W') THEN
DO
IF string>level THEN
DO
arg=STRIP(string arg)
string='D'
END
ELSE
DO
dirnum=string
CALL chdir2()
CALL since()
END
END
IF string='QUICK' & level>0 THEN CALL do_quick(1)
opt=LEFT(string,1)
IF opt='G' THEN
DO
IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?'
END
go=1 /* check for access */
t=bbspath'BBS_TEXT/COM.'opt
IF UPPER(arg)='EDIT' & level>sysoplevel THEN
DO
CALL edinfo(t,opt,'Menu Command')
opt=''
END
IF ~terseflag THEN CALL showtext(t 1)
IF POS(opt,UPPER(commands))=0 THEN go=0
END
IF CBVflag=1 THEN SIGNAL OUT
CALL postuser(1)
OPTIONS PROMPT 'Filename: '
SELECT
WHEN opt='A' THEN CALL showalpha()
WHEN opt='B' THEN CALL browse()
WHEN opt='C' THEN CALL editor(name maxtime-TRUNC(TIME('E')) 'MAIL' sysop . 0 0 'FEEDBACK')
WHEN opt='D' THEN CALL dload()
WHEN opt='E' THEN CALL readmail(level>0)
WHEN opt='F' THEN CALL do_F()
WHEN opt='H' THEN CALL help('MAIN')
WHEN opt='I' THEN CALL information()
WHEN opt='J' THEN CALL jump2rexx()
WHEN opt='K' THEN CALL killuser()
WHEN opt='L' THEN CALL list()
WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG'
WHEN opt='N' THEN CALL newfiles()
WHEN opt='O' THEN CALL otheruser()
WHEN opt='P' THEN CALL editor(name maxtime-TRUNC(TIME('E')) 'MSG' . . 0 0)
WHEN opt='R' THEN IF menu='NEW' THEN CALL CBV();ELSE CALL readmessages()
WHEN opt='S' THEN CALL bbsSEARCH()
WHEN opt='T' THEN CALL chpro()
WHEN opt='U' THEN CALL uload(1)
WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG' 1)
WHEN opt='W' THEN CALL showuserlist()
WHEN opt='X' THEN CALL switchmenuflag()
WHEN opt='Y' THEN CALL edituser()
WHEN opt='Z' THEN CALL counts()
WHEN opt='~' THEN CALL sysED(1)
WHEN opt='!' THEN CALL yell()
WHEN opt='@' THEN CALL shell()
WHEN opt='#' THEN CALL switchcolors()
WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
WHEN opt='%' THEN CALL editnote()
WHEN opt='^' THEN CALL readlogs()
WHEN opt='&' THEN CALL bbsProfiles.rexx(name level sysoplevel linesperpage colorflag maxtime-TIME('E') bbspath)
WHEN opt='+' THEN CALL ext_dload()
WHEN opt='(' THEN CALL filereport()
WHEN opt=')' THEN CALL mailreport()
WHEN opt='=' THEN CALL levelreport()
WHEN opt=';' THEN CALL changename()
WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END
WHEN opt='.' THEN IF menu~='ALL' THEN menu='MAIN'
WHEN opt='?' THEN IF menuflag THEN CALL help('MAIN')
OTHERWISE NOP
END
END
SIGNAL LOGOUT
EXIT
/* FUNCTIONS */
do_F:
IF menu='FILE' | menu='ALL' THEN
DO
IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN
DO
SAY CR
SAY 'Sorry! Not enough memory left for background archiving.'CR
SAY 'Please try again in 10 minutes or so.'CR
SAY CR
RETURN
END
DO i=0 TO libs.0
CALL SETCLIP('BBS_libs.'i,libs.i)
END
IF Make_BrowseList.baud(name colorflag files.0)=0 THEN
DO
CALL send2log('Arc: Make_BrowseList.baud')
IF emailonline>=0 THEN emailonline=emailonline+1
END
DO i=0 TO libs.0
CALL SETCLIP('BBS_libs.'i)
END
END
ELSE IF menu~='ALL' THEN menu='FILE'
RETURN
cleanstring:
PARSE ARG nflag':'cstr
IF nflag=1 THEN
DO
cstr=COMPRESS(cstr,"'`")
cstr=TRANSLATE(cstr,,namemask)
cstr=SPACE(cstr,1,'_')
RETURN cstr
END
bot=XRANGE(,'1F'x)
IF nflag=2 THEN bot=COMPRESS(bot,'1B'x) /* ESC for ANSI */
ELSE cstr=strip_ansi(cstr)
top=XRANGE('7F'x)
cstr=COMPRESS(cstr,bot||top)
IF nflag=0 THEN cstr=STRIP(cstr)
RETURN cstr
showtext:
PARSE ARG starg warg .
IF EXISTS(starg'.'colorflag) THEN
DO
IF OPEN(f,starg'.'colorflag,'R')=0 THEN RETURN
t=READCH(f,65000)
CALL CLOSE(f)
SAY t
END
ELSE IF EXISTS(starg) THEN
DO
CALL readlines(starg 1)
IF colorflag=0 THEN CALL strip_lynes()
CALL seelines(1)
END
ELSE RETURN
IF warg THEN
DO
CALL waiting()
nonstop=0
END
RETURN
strip_lynes:
DO i=1 TO lynes.0
lynes.i=strip_ansi(lynes.i)
END
RETURN
strip_ansi:
PARSE ARG aline
n=POS('1B'x,aline)
DO WHILE n>0
DO k=2
IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
leave k
END
aline=DELSTR(aline,n,k+1)
n=POS('1B'x,aline)
END
RETURN aline
doGrin:
IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
CALL setdir(bbspath'rexxDoors')
temp=Grin_du_Jour.rexx()
SAY CR
RETURN temp
send2log:
PARSE ARG sendline
logfile=bbspath'Logs/log.'DATE('S') /* daily logs */
fl='W'
IF EXISTS(logfile) THEN fl='A'
IF ~OPEN('log',logfile,fl) THEN
DO
IF ~OPEN('log',logfile,fl) THEN
DO
SAY 'failed to open log file'
RETURN
END
END
CALL WRITELN('log',sendline)
CALL CLOSE('log')
IF bbsprefs.3=1 THEN CALL WRITELN(p,sendline)
RETURN
send2last:
PARSE ARG sendline
IF bbsprefs.24~=1 & name=sysop THEN RETURN
ADDRESS AREXX bbsLog99.rexx 'USER' sendline
RETURN
do_quick:
ARG flag .
CALL postfour('QUICK:')
IF FIND(UPPER(data.8),'QUICK')=0 THEN
DO
SAY CR
SAY 'The QUICK option is OFF in your current settings.'CR
SAY CR
SAY 'Setting the QUICK option to ON will allow you to tell the BBS to'CR
SAY 'make a .lha archive of all new bbs activity since your last call.'CR
SAY CR
SAY 'This archive can then be read (and replied to, and files can be'CR
SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply'CR
SAY 'module for BBBBS, which is available here in the file libraries.'CR
SAY CR
IF getinput(1 1 'Turn the QUICK option ON? (Ny) > ')~='Y' THEN RETURN
data.8=data.8 'QUICK'
CALL savedata(0)
END
ELSE IF flag=1 THEN
DO
IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN
DO
temp=data.8
data.8=''
DO i=1 TO WORDS(temp)
IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i))
END
ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?'
RETURN
END
END
IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN
DO
SAY CR
SAY 'You may EXCLUDE any of these from your QUICK archives.'CR
SAY pen3||LEFT('-',74,'-')||def||CR
temp=LEFT(' ',7)
SAY temp'HELLO - Pre-logon message.'CR
SAY temp'WELCOME - Post-logon message.'CR
SAY temp'GOODBYE - Logoff message.'CR
SAY temp'HOURLY - Average-Minutes-Per-Hour usage graph.'CR
SAY temp'STATS.BBS - Most of the Z command from the main menu.'CR
SAY temp'filename - ANY filename in the Information area.'CR
SAY temp'MESSAGES - New conference messages.'CR
SAY temp'FILELIST - New file descriptions.'CR
SAY pen3||LEFT('-',74,'-')||def||CR
SAY 'Enter a space separated list of what you wish to exclude.'CR
SAY pen3'Exclude:'def data.26||CR
temp=getinput(1 0 pen3'Exclude: 'def)
IF temp='' & data.26~='' THEN
DO
IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN
data.26=''
END
ELSE data.26=temp
temp='Your QUICK archives will exclude'pen3
IF data.26='' THEN temp=temp 'nothing!'
ELSE temp=temp data.26
SAY temp||def||CR
CALL savedata(0)
SAY CR
END
IF GETCLIP('BBS_'name)~='' THEN
DO
SAY CR
SAY 'The QUICK routines are still working on your archive...'CR
SAY 'Please try again later.'CR
SAY CR
RETURN
END
quickdir=bbspath'EmailFiles/'name
CALL MAKEDIR(quickdir)
CALL setdir(quickdir)
qdarg=scratch'/dirlist'
ADDRESS COMMAND 'C:list >'qdarg quickdir'/QUICK_#? DATES'
efiles=UPPER(SHOWDIR(quickdir))
qflag=0
das=0
IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN
DO
das=1
SAY 'Working...'CR
DO i=1 TO WORDS(efiles)
qarg=WORD(efiles,i)
IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
DO
SAY CR
SAY 'There is already a QUICK_xxxxx.LHA file in your mailbox...'CR
SAY 'Activity request has been CANCELLED!'CR
SAY CR
das=0
LEAVE i
END
END
END
IF das=1 THEN
DO
CALL SETCLIP('BBS_city',city)
CALL SETCLIP('BBS_'name'_26',data.26)
IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN
CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0)
IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
CALL SETCLIP('BBS_'name'_22',data.22)
CALL MAKEDIR(bbspath'EmailFiles/'name)
CALL showmarked(0)
CALL SETCLIP('BBS_QUICKOUT_BAUD',bps)
ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21
CALL send2log('Started QUICKOUT at' TIME('C'))
IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
DO
clear_marked=1
DO i=1 TO level
IF WORD(data.22,i)~=-1 THEN
lastread.i=countcheck('Numbers/LastMessage'i 0)
END
END
IF FIND(UPPER(data.26),'FILELIST')=0 THEN
lastbrowse=countcheck('Numbers/LastFile' 0)
newfilesdate=DATE('S') TIME()
IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN
DO
DO i=1 TO libs.0
CALL WRITELN(f,libs.i)
END
CALL CLOSE(f)
END
IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN
DO
DO i=1 TO msgs.0
CALL WRITELN(f,msgs.i)
END
CALL CLOSE(f)
END
CALL savedata(1)
qflag=1
END
IF WORD(STATEF(qdarg),2)>80 THEN
DO
CALL showtext(qdarg 0)
SAY CR
END
DO qi=1 TO WORDS(efiles)
qarg=WORD(efiles,qi)
IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
DO
SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.'CR
allargs=qarg
DO WHILE dload2()=1
END
t=''
DO WHILE t~='N' & t~='Y'
t=getinput(1 1 'Delete' qarg'? (ny) > ')
END
IF t='Y' THEN
DO
IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.'CR
CALL DELETE(quickdir'/'qarg'.xdl')
qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA')
CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg)
END
END
END
arg=''
IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN
DO
arg='QUICKIN.lha'
ul=2
DO WHILE ul=2
ul=uload(0)
END
END
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN
IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN
DO
ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
SAY CR
SAY 'Processing QUICKIN archive...'CR
END
IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN
DO
IF qflag THEN SAY 'Your archive will be waiting next time you call...'CR
SAY CR
SIGNAL LOGOUT2
END
IF qflag THEN
DO
SAY CR
SAY 'Note: You now have no ''new'' files or messages (they are being archived).'CR
SAY CR
SAY 'You will be signaled if you are still online when your archive is ready...'CR
SAY CR
CALL waiting()
END
CALL setdir(libpath||dirs.1)
RETURN
killuser:
ARG kname .
IF level<=sysoplevel THEN RETURN
CALL bbsKillUser.rexx(kname)
RETURN
menus:
CALL checkdcd()
IF OPEN(f,bbspath'BBS_TEXT/MENU_'menu'.'colorflag,'R')~=0 THEN
DO
m=READCH(f,65000)
CALL CLOSE(f)
SAY m
IF level>sysoplevel THEN
DO
SAY ' ['pen3'K'def']ill a user ['pen3'%'def'] edit filenote ['pen3'='def'] level report'def||CR
SAY ' ['pen3'^'def'] view BBS logs ['pen3'('def'] file report ['pen3';'def'] change username'def||CR
END
IF level=99 THEN
SAY ' ['pen3'~'def'] online editor ['pen3'@'def'] dos shell ['pen3')'def'] email report'def||CR
END
ELSE IF menu='NEW' THEN
DO
SAY pen6' _________________'def||CR
SAY pen6' __/ 'pen3'New User Menu'pen6' \___'def||CR
SAY pen6' | |'def||CR
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'I'def']nformation 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'W'def']ho is here 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'S'def']earch user list 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def||CR
SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'X'def'] toggle menus 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'#'def'] toggle color 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def||CR
SAY pen6' |________________________|'def||CR
IF bbsprefs.22~=0 THEN
DO
SAY CR
SAY 'Local Callers may register and receive' pen7'INSTANT VALIDATION'def'!'CR
SAY 'Enter R to ['pen3'R'def']egister using Call Back Verify.'CR
END
END
ELSE IF menu='MSG' THEN
DO
SAY pen6' ____________'def||CR
SAY pen6' ____/ 'pen3'Messages'pen6' \_____'def||CR
SAY pen6' | |'def||CR
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'P'def']ost messages 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'R'def']ead messages 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'S'def']earch messages 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'E'def']mail (private) 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'QUICK'def'] options 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'FL'def'] Friends List 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
SAY pen6' |'def' ['pen3'^'def'] view BBS logs 'pen6'|'def||CR
SAY pen6' |'def' ['pen3')'def'] email report 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'='def'] level report 'pen6'|'def||CR
SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def||CR;END
IF(level=99) THEN DO
SAY pen6' |'def' ['pen3'~'def'] online editor 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def||CR;END
SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def||CR
SAY pen6' |_______________________|'def||CR
END
ELSE IF menu='FILE' THEN
DO
SAY pen6' _________'def||CR
SAY pen6' ______/ 'pen3'Files'pen6' \_______'def||CR
SAY pen6' | |'def||CR
SAY pen6' |'def' ['pen3'A'def']lphabetic list 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'B'def']rowse filenotes 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'N'def']ew files list 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'L'def']ist by Library 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'F'def']ilelist archives 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'S'def']earch files 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'U'def']pload 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'D'def']ownload 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'T'def']ransfer protocol 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'+'def'] Extra Devices 'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
SAY pen6' |'def' ['pen3'K'def']ill a user 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'%'def'] edit filenote 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'('def'] file report 'pen6'|'def||CR
SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def||CR;END
IF(level=99) THEN DO
SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def||CR;END
SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def||CR
SAY pen6' |________________________|'def||CR
END
ELSE IF menu='MAIN' THEN
DO
SAY pen6' _____________'def||CR
SAY pen6' ____/ 'pen3'Main Menu'pen6' \_____'def||CR
SAY pen6' | |'def||CR
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'I'def']nfomation 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'J'def']ump to doorways 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'W'def']ho is here list 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'S'def']earch userlist 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'O'def']ther users info 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'X'def']pert (no menus) 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'#'def'] toggle colors 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'$'def'] toggle menu(s) 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'&'def'] user profiles 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def||CR
SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def||CR
SAY pen6' |________________________|'def||CR
END
ELSE IF menu='ALL' THEN
DO
SAY pen6' __________________________________________________________'def||CR
SAY pen6' __/ 'pen3'Main Menu File Menu Message Menu 'pen6' \__'def||CR
SAY pen6' | |'def||CR
SAY pen6' |'def' ['pen3'H'def']elp ['pen3'A'def']lphabetical list ['pen3'P'def']ost messages 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'I'def']nformation ['pen3'B'def']rowse filenotes ['pen3'R'def']ead messages 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics ['pen3'L'def']ist by Library ['pen3'E'def']mail (private) 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'Y'def']our user data ['pen3'N'def']ew files ['pen3'C'def']omment to SYSOP 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'O'def']ther users info ['pen3'F'def']ilelist archiver ['pen3'!'def'] YELL for SYSOP 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'J'def']ump to doorways ['pen3'+'def'] Extra Devices ['pen3'X'def']pert (no menus) 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'S'def']earch menu ['pen3'D'def']ownload ['pen3'$'def'] toggle menu(s) 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'&'def'] user profiles ['pen3'U'def']pload ['pen3'#'def'] toggle colors 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'V'def']iew user log ['pen3'T'def']ransfer protocol ['pen3','def'] hourly stats 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'G'def']oodbye (logoff) ['pen3'QUICK'def'] options ['pen3'FL'def'] Friends List 'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
SAY pen6' |'def' ['pen3'K'def']ill a user ['pen3'%'def'] edit filenote ['pen3'='def'] level report 'pen6'|'def||CR
SAY pen6' |'def' ['pen3'^'def'] view BBS logs ['pen3'('def'] file report ['pen3';'def'] change username 'pen6'|'def||CR;END
IF(level=99) THEN
SAY pen6' |'def' ['pen3'~'def'] online editor ['pen3'@'def'] dos shell ['pen3')'def'] email report 'pen6'|'def||CR
SAY pen6' |________________________________________________________________|'def||CR
END
QUEUE CR /* clears any un-CRed input in the queue */
RETURN
help:
ARG helppath .
SAY CR
SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'CR
IF helppath='MAIN' THEN
SAY 'Commands available from the' pen3||menu||def 'menu:'CR
frontend=bbspath'BBS_HELP/'helppath
backend='.USER'
IF level=0 THEN backend='.NEW'
ELSE IF level=99 THEN backend='.SUPER'
ELSE IF level>sysoplevel THEN backend='.SYSOP'
CALL showtext(frontend||backend 1)
RETURN
waiting:
CALL checktime()
IF waitchar='Q' THEN
DO
waitchar=''
RETURN
END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3' RETURN=Continue 'def
PULL waitchar
CALL cleanline(1)
CALL checkdcd()
RETURN
waiting2:
CALL checktime()
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3' Q=Quit N=Non-Stop RETURN=Continue 'def)
IF waitchar='N' THEN
DO
nonstop=1
SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E 'def||CR
SAY CR
CALL DELAY(99)
waitchar=''
END
CALL cleanline(1)
CALL checkdcd()
IF waitchar='Q' THEN RETURN 1
RETURN 0
busywait:
ARG bii bi bt
IF bii>4 & bi//(10*bii)=0 THEN CALL checkdcd()
IF bbsprefs.21=0 THEN RETURN
IF bi<1 THEN
DO
CALL WRITECH(STDOUT,'080808'x)
IF ni<1 & i>999998 & wi>999998 THEN SAY CR
RETURN
END
IF bi=1 THEN CALL WRITECH(STDOUT,' ')
IF bi//(bii%2)~=0 THEN RETURN
b=bi//bii
IF b=0 | b=bii%2 THEN
DO
tp=RIGHT((bi*100)%bt,2)'%'
CALL WRITECH(STDOUT,'080808'x||tp)
END
RETURN
cleanline:
ARG lflag .
IF nonstop=0 & clr~='' THEN
DO
Send clr
RETURN
END
cline=lineup||LEFT(' ',78)
IF lflag=1 THEN cline=cline||lineup
SAY cline||CR
RETURN
getinput:
PARSE ARG upflag' 'oneflag' 'pline
CALL checkdcd()
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
inarg=cleanstring(0':'inarg)
RETURN inarg
docity:
PARSE ARG citi
citi=TRANSLATE(citi,' ','+-.,*/()<>')
DO i=WORDS(citi) TO 1 BY -1
IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
END
citi=SPACE(citi,1)
RETURN STRIP(citi)
postuser:
IF bbsprefs.12~=1 | ~SHOW('P','BBSPOST') THEN RETURN
ARG upflag .
IF upflag=6 THEN ptext='Logoff:' DATE() TIME('C')' 'name city
ELSE IF upflag=7 THEN ptext=name' is a NEW USER!'
ELSE ptext='LogOn:' logontime' 'name city' Last On:' DATE(,lastondate,'I')
ptext=CENTER(ptext,74)
CALL SETCLIP('BBSPOST1',ptext)
age='?'
IF UPPER(WORD(data.12,3))='BIRTHDAY:' THEN
DO
IF DATATYPE(WORD(data.12,4),'W') THEN
DO
age=LEFT(DATE('S'),4)-LEFT(WORD(data.12,4),4)
IF SUBSTR(DATE('S'),5,2)<SUBSTR(WORD(data.12,4),5,2) THEN age=age-1
END
END
IF age='?' & WORD(data.12,4)~='' THEN age=WORD(data.12,4)
ptext=CENTER('Baud:' bps' Age:' age' Usage:' data.19,74)
CALL SETCLIP('BBSPOST2',ptext)
ptext2=''
ptext1=data.1' '
IF DATATYPE(WORD(data.12,1),'W') THEN
ptext2=ptext2' First On:' DATE(,WORD(data.12,1),'S')
n=74-LENGTH(ptext1)-LENGTH(ptext2)
ptext2=ptext1||STRIP(LEFT(data.9,n))||ptext2
ptext2=CENTER(ptext2,74)
CALL SETCLIP('BBSPOST3',ptext2)
ulb=WORD(data.14,3)
IF ~DATATYPE(ulb,'W') | ulb=0 THEN ulb=1
dlb=WORD(data.15,3)
IF ~DATATYPE(dlb,'W') THEN dlb=0
ptext='Level: 'level' dl/ul:' comma(TRUNC(dlb/ulb+.005,2))
IF upflag=0 THEN ptext=ptext
IF upflag=1 THEN ptext=ptext' Cmd:' opt arg
IF upflag=2 THEN ptext=ptext' MSG:' msg.msgdir
IF upflag=3 THEN ptext=ptext' Email'
IF upflag=4 THEN ptext=ptext' ul:' plaindir'/'arg
IF upflag=5 THEN ptext=ptext' dl:' plaindir'/'arg
IF upflag=6 THEN ptext=ptext' Elapsed:'elapsed' '
CALL SETCLIP('BBSPOST4',CENTER(ptext,74))
ADDRESS BBSPOST 'UPDATE'
ptext=''
IF EXISTS(bbspath'Email/'sysop'/NEW_FILES') THEN ptext='NEW_FILES !'
IF EXISTS(bbspath'Lists/CBV_USERS') THEN ptext=ptext 'CBV_USERS !'
IF EXISTS(bbspath'Lists/NEW_USERS') THEN ptext=ptext 'NEW_USERS !'
IF chatrequest=1 THEN ptext=ptext 'CHAT REQUEST !'
ptext=STRIP(ptext GETCLIP('BBS_ERROR'))
CALL SETCLIP('BBS_ERROR')
IF ptext='' THEN ptext=' '
ELSE ptext=CENTER('!' ptext,74)
IF ptext~=GETCLIP('BBSPOST5') THEN
DO
CALL SETCLIP('BBSPOST5',ptext)
ADDRESS BBSPOST 'UPDATE'
END
RETURN
postfour:
PARSE ARG parg
IF bbsprefs.12~=1 | ~SHOW('P','BBSPOST') THEN RETURN
ptext='Level: 'level' dl/ul:' comma(TRUNC(dlb/ulb+.005,2))
CALL SETCLIP('BBSPOST4',CENTER(ptext' 'parg,74))
ADDRESS 'BBSPOST' 'UPDATE'
RETURN
whodat:
MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||'
'||'
'||' 'name' level 'level' '||'
'
RETURN
showtime:
mins=TIME('E')%60
secs=TRUNC(TIME('E')//60)+1
IF secs>59 THEN secs=59
IF secs<10 THEN secs='0'secs
line=' Time: Used' mins':'secs
mins=(maxtime-TIME('E'))%60
secs=TRUNC((maxtime-TIME('E'))//60)
IF secs<10 THEN secs='0'secs
line=line' Remaining' mins':'secs
SAY line||CR
checktime:
IF TIME('E')>maxtime THEN
DO
SAY 'Sorry,' name 'your time has expired.'CR
CALL send2log('*** Time Expired ***')
SIGNAL LOGOUT2
END
IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
CALL whodat()
CALL checkemail()
CALL checkdcd()
RETURN
setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
Data directory
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN
config:
arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
DO
SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
SIGNAL DONE2
END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
CALL SETCLIP('BBS_bbsname',bbsname)
sysop=WORD(lynes.2,1)
compos=POS('/*',lynes.3)
IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
exclusion=STRIP(lynes.3)
bbsdevice=WORD(lynes.4,1)
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
DO
SAY bbspath 'does not exist!'CR
SIGNAL DONE2
END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
msgpath=WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
DO
SAY msgpath 'does not exist!'CR
SIGNAL DONE2
END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
CALL SETCLIP('BBS_msgpath',msgpath)
msgpath=msgpath'MSG'
libpath=WORD(lynes.8,1)
IF ~EXISTS(libpath) THEN
DO
SAY libpath 'does not exist!'CR
SIGNAL DONE2
END
testchar=RIGHT(libpath,1)
IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
CALL SETCLIP('BBS_libpath',libpath)
extdevs=''
DO i=1 TO WORDS(lynes.10)
test=WORD(lynes.10,i)
IF POS(':',test)=0 THEN ITERATE i
IF LEFT(test,2)='/*' THEN LEAVE i
extdevs=STRIP(extdevs test)
END
SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
maxidle=WORD(lynes.13,1)
maxtime=WORD(lynes.14,1)
maxbps=WORD(lynes.15,1)
IF ~DATATYPE(maxbps,'W') THEN maxbps=2400
CALL SETCLIP('BBS_baud',maxbps)
DO i=16 TO 41
j=i-15
bbsprefs.j=STRIP(WORD(lynes.i,1))
END
spellpath=WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
DO
SAY spellpath 'does not exist!'CR
bbsprefs.5=0
END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)
IF bbsprefs.12=1 THEN
IF ~SHOW('P','BBSPOST') THEN ADDRESS AREXX bbsPOST.baud
IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
extension=WORD(lynes.32,1)
arccom=lynes.33
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
DO
extension='.lzh'
arccom='lharc -m m'
END
lpost=WORD(lynes.34,1)
IF ~DATATYPE(lpost,'W') THEN lpost=3
rpost=WORD(lynes.35,1)
IF ~DATATYPE(rpost,'W') THEN rpost=11
IF SHOW('P','BBSPOST') THEN ADDRESS 'BBSPOST' 'CONFIG' lpost rpost
compos=POS('/*',lynes.42)
IF compos>0 THEN lynes.42=LEFT(lynes.42,compos-1)
bbsprefs.27=STRIP(lynes.42)
real=1
IF WORD(lynes.43,1)=0 THEN real=0
RETURN
readlogs:
t=getinput(1 1 'Read [D]aily, [N]umbers, or [Q]uick log? (dnq) > ')
IF t='' THEN RETURN
IF t='D' THEN
DO
arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
IF arg='' THEN arg=DATE('S')
arg=bbspath'Logs/log.'arg
END
ELSE IF t='N' THEN arg=bbspath'logs/QUICK.log'
ELSE IF t='Q' THEN arg=bbspath'logs/Numbers.log'
ELSE RETURN
CALL showtext(arg 1)
RETURN
loadcourtesy:
IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
DO
IF readopen(bbspath'Lists/Courtesy') THEN
DO
SAY 'Checking Courtesy List...'CR
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
line=cleanstring(1':'line)
courtesy=courtesy line
END
CALL CLOSE(f)
MSG ''
MSG pen3'Courtesy List:'def
MSG courtesy
END
END
RETURN
fileheader:
SAY 'Filename Bytes File# Library KeyWords'CR
SAY pen3||LEFT('=',77,'=')||def||CR
RETURN
showalpha:
libtext=0
IF DATATYPE(arg,'W') THEN
DO
dirnum=arg
arg=''
test='Y'
IF chdir2()>0 THEN
DO
libtext=1
RETURN
END
END
ELSE
DO
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
DO
IF chdir()>0 THEN
DO
libtext=1
RETURN
END
END
END
showalpha2:
libtext=1
IF test='Y' THEN
DO
CALL postfour('AlphaList:' plaindir)
lfile=libpath||plaindir'/.'STRIP(LEFT(plaindir,15))
IF EXISTS(lfile) THEN
DO
CALL showtext(lfile 1)
nonstop=0
RETURN
END
filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
END
ELSE filecount=files.0
SAY ' 'filecount 'files.'CR
CALL fileheader()
count=0
DO wi=1 TO alpha.0
CALL busywait(60 wi alpha.0)
IF test='Y' THEN
DO
IF count>=filecount THEN LEAVE wi
IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN
ITERATE wi
END
jj=WORD(alpha.wi,4)
IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
ITERATE wi
CALL busywait(4 0)
SAY alpha.wi||CR
count=count+1
IF (count+2)//linesperpage=0 & wi<alpha.0 THEN
IF waiting2() THEN
DO
CALL busywait(4 1)
LEAVE wi
END
CALL busywait(4 1)
END
CALL busywait(4 0)
nonstop=0
IF waitchar~='Q' THEN CALL waiting()
RETURN
otheruser:
SAY lm
CALL bbsOther.rexx(maxtime-TRUNC(TIME('E')) name sysoplevel real bbspath bbsname)
RETURN
changename:
ARG cname
IF level<=sysoplevel THEN RETURN
IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
IF WORD(lynes.20,1)>level THEN RETURN
CALL SETCLIP('BBS_oldname',cname)
CALL ChangeUserName.rexx()
ncname=GETCLIP('BBS_newname')
IF name=cname THEN name=ncname
IF GETCLIP('BBS_oldname')='' THEN
CALL send2log('Name change from' cname 'to' ncname)
sortuserflag=1
CALL SETCLIP('BBS_oldname')
CALL SETCLIP('BBS_newname')
RETURN ncname
levelreport:
SAY lm
CALL bbsNewUsers.rexx(name level colorflag maxtime-TRUNC(TIME('E')))
RETURN
filereport:
SAY 'Searching for mismatches between files and filenotes...'CR
DO i=1 TO sysoplevel+1
IF dirs.i='' THEN ITERATE
SAY dirs.i' 'lineup||CR
rfiles=SHOWDIR(libpath||dirs.i)
rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
IF WORDS(rfiles)~=WORDS(rnotes) THEN
DO
line='Compare files & filenotes in'pen3 dirs.i||def'. '
DO j=1 TO WORDS(rfiles)
IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
line=line WORD(rfiles,j)
END
SAY line||CR
END
END
Send '^G'
CALL waiting()
RETURN
mailreport:
SAY 'Checking ALL pending Email...'CR
SAY pen3' - Use CTRL-E to Exit -'def||CR
SAY CR
mailrep=SHOWDIR(bbspath'Email','D')
mailfil=SHOWDIR(bbspath'EmailFiles','D')
lastemail=WORD(data.17,3)
IF ~DATATYPE(lastemail,'W') THEN lastemail=0
IF lastemail=countcheck('Numbers/LastMail' 0) THEN
DO
DROP mailrep. mailfil.
RETURN
END
mailynes.=''
mk=0
DO mi=1 TO WORDS(mailrep)
muser=WORD(mailrep,mi)
IF muser=sysop | muser=name THEN ITERATE mi
mlist=SHOWDIR(bbspath'Email/'muser)
IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)||CR
DO mj=1 TO WORDS(mlist)
fuser=WORD(mlist,mj)
IF POS(sysop,fuser)>0 THEN ITERATE mj
IF logonflag=0 THEN
DO
mk=mk+1
mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
END
IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
DO
testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
IF testnum>emailnum THEN emailnum=testnum
IF testnum>lastemail THEN
DO
CALL showtext(bbspath'Email/'muser'/'fuser 1)
SAY CR
SAY CR
IF waitchar='Q' THEN LEAVE mi
END
END
END
IF logonflag=0 & FIND(mailfil,muser)>0 THEN
DO
efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
IF WORDS(efilelist)>0 THEN
DO
mk=mk+1
mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
END
END
END
data.17=WORD(data.17,1) WORD(data.17,2) countcheck('Numbers/LastMail' 0)
IF mk>0 THEN
DO
lynes.0=mk
DO mi=1 TO mk
lynes.mi=mailynes.mi
END
CALL seelines(1)
nonstop=0
CALL waiting()
END
ELSE SAY 'No unseen Email pending.'CR
DROP mailrep. mailfil. mailynes. mlist
RETURN
jump2rexx:
arg=bbspath'BBS_TEXT/REXXDOORS'
IF EXISTS(arg) THEN CALL showtext(arg 0)
CALL sound('JUMP')
SAY lm
CALL bbsDoors.rexx(TRUNC(maxtime-TIME('E'))-42 name password)
x=GETCLIP('BBS_maxtime')
CALL SETCLIP('BBS_maxtime')
IF DATATYPE(x,'W') THEN maxtime=x+TIME('E')
x=GETCLIP('BBS_winnings')
IF DATATYPE(x,'W') THEN winnings=x
CALL SETCLIP('BBS_winnings')
RETURN
sortlibraries:
SAY 'Sorting Libraries...'CR
count=0
sdirs.=''
DO i=1 TO level
IF dirs.i='' THEN ITERATE i
count=count+1
sdirs.count=dirs.i i
END
sdirs.0=count
IF count>0 THEN CALL QSort(1,count,sdirs)
count=0
libs.=''
DO i=1 TO sdirs.0
tempnum=WORD(sdirs.i,2)
tempdir=WORD(sdirs.i,1)
IF FIND(data.21,UPPER(tempdir))=0 THEN
DO
string=' '
IF tempnum<10 THEN string=string' '
string=string || tempnum'. 'LEFT(tempdir,14)
count=count+1
libs.count=string
END
END
libs.0=count%4
IF (count//4)>0 THEN libs.0=libs.0+1
DO i=1 TO libs.0
DO j=1 TO 3
k=i+j*libs.0
IF k<=count THEN libs.i=libs.i||libs.k
END
END
DROP sdirs.
RETURN
sortconferences:
SAY 'Sorting Conferences...'CR
count=0
smsg.=''
DO i=1 TO level
IF msg.i='' THEN ITERATE i
count=count+1
smsg.count=msg.i i
END
smsg.0=count
IF count>0 THEN CALL QSort(1,count,smsg)
count=0
msgs.=''
DO i=1 TO smsg.0
tempnum=WORD(smsg.i,2)
tempdir=WORD(smsg.i,1)
IF FIND(data.21,tempnum)=0 THEN
DO
string=' '
IF tempnum<10 THEN string=string' '
string=string || tempnum'.'
IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
string=string LEFT(tempdir,20)
ELSE string=string pen2'-OFF-'def LEFT(tempdir,14)
count=count+1
msgs.count=string
END
END
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
DO j=1 TO 2
k=i+j*msgs.0
IF k<=count THEN msgs.i=msgs.i msgs.k
END
END
DROP smsg.
RETURN
readmessages:
SAY lm
CALL SETCLIP('BBSMSG_ARG',colorflag arg)
CALL bbsMsg.rexx(maxtime-TRUNC(TIME('E')) name password)
CALL loaddata()
CALL checkemail()
RETURN
showmarked:
ARG ff .
IF WORDS(data.24)<1 THEN RETURN
fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'
IF ff THEN
DO
SAY CR
SAY pen6||fline||def||CR
END
tempkk=data.24
DO i=1 TO WORDS(tempkk)
tempk=WORD(tempkk,i)
PARSE VAR tempk kdir'/'kmsg
line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference'
IF EXISTS(msgpath||tempk) THEN
DO
IF ff THEN SAY line'.'CR
ELSE fline=fline'0A'x||line'.'
END
ELSE
DO
line=line 'is missing.'
IF ff THEN SAY line||CR
ELSE fline=fline'0A'x||line
mkw=FIND(data.24,tempk)
data.24=STRIP(DELWORD(data.24,mkw,1))
CALL savedata(0)
END
END
IF ff THEN
DO
CALL waiting()
SAY CR
END
ELSE
DO
IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN
CALL WRITELN(f,fline)
CALL CLOSE(f)
END
RETURN
readmail:
ARG fromenu .
replysubj=''
IF fromenu THEN SAY lm
ELSE arg=''
CALL SETCLIP('BBSMAIL_ARG',fromenu arg)
allargs=bbsMail.rexx(maxtime-TRUNC(TIME('E')) name password)
CALL loaddata()
IF DATATYPE(allargs,'N') THEN allargs=''
IF allargs~='' THEN
DO
CALL dload2()
CALL readmail(0)
END
CALL checkemail()
RETURN
checkemail:
x=GETCLIP('BBS_email')
CALL SETCLIP('BBS_email')
If DATATYPE(x,'W') THEN
IF emailonline>-1 THEN emailonline=emailonline+x
RETURN
countcheck:
PARSE ARG fname' 'cknum .
fname=bbspath||fname
IF ~EXISTS(fname) THEN
DO
IF cknum=0 THEN RETURN 0
IF ~writeopen(fname) THEN RETURN 0
CALL WRITELN(f,cknum)
CALL CLOSE(f)
RETURN cknum
END
IF ~readopen(fname) THEN
DO
CALL DELAY(99)
IF ~readopen(fname) THEN RETURN cknum
END
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'W') THEN retval=0
IF ~DATATYPE(cknum,'W') THEN cknum=0
IF retval<cknum THEN
DO
IF writeopen(fname) THEN
DO
CALL WRITELN(f,cknum)
CALL CLOSE(f)
RETURN cknum
END
END
RETURN retval
sysED:
IF level<99 THEN RETURN
arg=getinput(0 0 'Textfile To Edit: ')
IF arg='' THEN RETURN
SAY lm
CALL bbsEd.rexx(1 arg name TRUNC(maxtime-TIME('E'))-28)
CALL checkfilechanges()
RETURN
editor:
PARSE ARG edarg
SAY lm
IF bbsWrite.rexx(edarg)=0 THEN RETURN
IF WORD(edarg,3)='MAIL' THEN
DO
IF emailonline>=0 THEN emailonline=emailonline+1
END
ELSE
DO
grand=grand+1
IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1
ELSE msg.msgdir.0=msg.msgdir.0+1
END
CALL loaddata()
RETURN
edinfo:
PARSE ARG t1,t2,t3
IF level<sysoplevel THEN RETURN 0
IF getinput(1 1 'Edit the'pen3 t2 def||t3 'info file? (Ny) > ')='Y' THEN
DO
IF ~EXISTS(t) THEN
DO
IF writeopen(t1)~=0 THEN
DO
CALL WRITELN(f,TRIM(CENTER('***'pen3 t2 def||t3 '***',75)))
CALL WRITELN(f,LEFT('',75,'='))
CALL CLOSE(f)
CALL DELAY(28)
END
END
CALL bbsEd.rexx(1 t1 name TRUNC(maxtime-TIME('E'))-28)
RETURN 1
END
RETURN 0
shell:
SAY CR
olddir=PRAGMA('D')
DO WHILE(UPPER(opt)~='EXIT')
SAY bak2||TIME('C')||def PRAGMA('D')||CR
OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
PARSE PULL opt' 'arg
CALL checkdcd()
IF(UPPER(opt)='CD') THEN CALL setdir(arg)
ELSE IF EXISTS(opt)~=0 THEN
DO
IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
END
ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
ADDRESS COMMAND opt '<* >*' arg
END
CALL PRAGMA('D',olddir)
RETURN
yell:
chatrequest=1
IF excuses.1='' THEN
DO
IF readopen(bbspath'Lists/Excuses') THEN
DO
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
excuses.i=line
END
excuses.0=i-1
CALL CLOSE(f)
END
END
j=TIME('S')//excuses.0+1
SAY CR
SAY 'Sorry, your SysOp,' sysop','CR
IF excuses.j~='' THEN SAY excuses.j||CR
ELSE SAY 'is not available, please leave a ['pen3'C'def']omment.'CR
SAY CR
IF bbsprefs.13=1 THEN RETURN
SAY 'I''m yelling anyway...'CR
SAY 'If nobody answers, please try again later or leave a ['pen3'C'def']omment'CR
CALL sound('YELL')
ADDRESS AREXX bbsSpeak.rexx 'CHAT' name bbspath saypath
RETURN
/* online change to member. Sysop triggered by BumpMember.baud */
/* user triggered by Call Back Verification */
validate:
ARG varg .
IF readopen(bbspath'BBS_TEXT/'varg) THEN
DO
SAY CR
SAY 'You are being validated. Please wait...'CR
SAY CR
DO lvi=1 TO 22
line=READLN(f)
IF lvi=11 THEN data.11=line
IF lvi=17 THEN data.17=WORD(line,1) WORD(data.17,2) WORD(data.17,3)
IF lvi=20 THEN data.20=line
IF lvi=21 THEN data.21=line
END
data.22=line
CALL CLOSE(f)
CALL setdata()
CALL sortlibraries()
CALL sortconferences()
CALL setmsgs()
SAY CR
CALL logonstats()
CALL savedata(0)
IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
DO
CALL MAKEDIR(bbspath'EMail/'name)
lastwrit=countcheck('Numbers/LastMail' 0)+1
IF lastwrit>1 THEN CALL countcheck('Numbers/LastMail' lastwrit)
lynes.=''
lynes.1=' Mail:' lastwrit
lynes.2=' From:' sysop
lynes.3=' To:' name
lynes.4=' Subj: Welcome to' bbsname
lynes.5=' Date:' DATE('W') DATE()' 'TIME('C')
lynes.6=LEFT('',74,'=')
CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
CALL savelines(bbspath'EMail/'name'/'sysop'.'lastwrit)
SAY 'You have welcoming EMail.'CR
END
CALL waiting()
IF bbsprefs.22=2 & varg='DEF.CBV' THEN
DO
SAY CR
SAY pen3||name def'is now a fully valadated member of'pen3 bbsname||def||CR
SAY 'All the features of the BBS will be available on your next call.'CR
SAY CR
CALL waiting()
SIGNAL LOGOUT2
END
SIGNAL RESTART
END
ELSE
DO
SAY 'Sorry. Auto-validation is disabled.'CR
temp=' ***' sysop'! You need a default file in BBS_TEXT! (' varg ') *** '
MSG bak2||temp||def||CR
CALL Send2log(temp)
END
RETURN
/* online time change. Sysop triggered by BumpTime.baud */
uptime:
mins=GETCLIP('BBS_minutes')
IF DATATYPE(mins,'N') THEN
DO
IF (mins*60)>maxtime THEN
SAY name', this session''s time has been increased to' mins 'minutes.'CR
ELSE MSG '*** User has not been told that his time has decreased.'
CALL SETCLIP('BBS_minutes')
maxtime=mins*60
END
RETURN
/* online level change. Sysop triggered by BumpLevels.baud */
uplevel:
levl=GETCLIP('BBS_level')
IF DATATYPE(levl,'W') THEN
DO
IF levl>data.20 THEN
SAY name', your level has been changed from' data.20 'to' levl'.'CR
ELSE MSG '*** User has not been told his level has been reduced.'
data.20=levl
CALL setdata()
IF menu='NEW' THEN menu='ALL'
CALL sortlibraries()
CALL sortconferences()
END
RETURN
/* online ratio change. Sysop triggered by BumpLevels.baud */
upratio:
rats=GETCLIP('BBS_ratio')
IF DATATYPE(rats,'W') THEN
DO
SAY name', your upload:download ratio has been changed to 1:'rats'.'CR
data.17=rats' 'WORD(data.17,2)' 'WORD(data.17,3)
CALL SETCLIP('BBS_ratio')
END
RETURN
bytes2user:
PARSE ARG indx bytes .
tfiles=WORD(data.indx,1)
tbytes=WORD(data.indx,3)
IF ~DATATYPE(tfiles,'W') THEN tfiles=0
IF ~DATATYPE(tbytes,'W') THEN tbytes=0
tbytes=tbytes+bytes
tfiles=tfiles+1
IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
ELSE data.indx='1 file' bytes 'bytes.'
data.indx=data.indx DATE()
CALL savedata(0)
RETURN
bbsspace:
ARG tabspace .
ADDRESS COMMAND 'C:info >'scratch'/infout' bbsdevice
ok=OPEN(f,scratch'/infout','R')
IF ok=0 THEN RETURN 20
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
IF tabspace<14 THEN SAY CR
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
DO
line=bbsdevice 'is not an info compatible device!'
CALL send2log(line)
SAY pen3||line||def||CR
bbsk=0
RETURN
END
bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
IF bbsk<1 THEN bbsk=0
SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
RETURN
comma: PROCEDURE
ARG num .
t=''
x=POS('.',num)
IF x>0 THEN t=SUBSTR(num,x)
num=num%1
dgt=LENGTH(num)
numtext=''
IF dgt>3 THEN numtext=','RIGHT(num,3)
IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
IF dgt>12 THEN
DO
numtext=','LEFT(RIGHT(num,12),3)||numtext
numtext=LEFT(num,dgt-12)||numtext
END
ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
ELSE numtext=num
RETURN numtext||t
is_here:
ARG newname
CALL WRITECH(STDOUT,'Checking filelist')
DO wi=1 TO 99
IF wi//3=0 THEN CALL WRITECH(STDOUT,'.')
IF dirs.wi='' THEN ITERATE wi
IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi
line=pen3'*** File' newname 'already exists here'
IF wi<=level THEN line=line 'in the' dirs.wi 'library'
line=line'.'def
SAY CR
SAY line||CR
SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR
CALL waiting()
RETURN 1
END
SAY CR
CALL cleanline(1)
RETURN 0
uload:
ARG frommenu
IF frommenu THEN
DO
SAY CR
SAY pen3'PLEASE!'def 'Only upload 1 (one) archive at a time. NO BATCH UPLOADING! Thanks.'CR
END
CALL bbsspace(12)
SAY CR
IF bbsk<1 THEN
DO
line='Upload area is full!'
CALL send2log(line)
SAY pen3||line||def||CR
RETURN 1
END
IF ~SHOW('P','BUILDALPHA') THEN CALL SETCLIP('BBS_UPLOAD')
IF frommenu & GETCLIP('BBS_UPLOAD')~='' THEN
DO
SAY pen3'Uploading is temporarily suspended while the filelists are rebuilding.'def
CALL waiting()
RETURN 1
END
IF arg='' THEN arg=getinput(0 0 'Filename: ') /* no filename given */
arg=cleanstring('0:'arg)
arg=COMPRESS(arg,' :/,;|#?*') /* be sure no illegals here */
IF UPPER(arg)='RZ' | UPPER(LEFT(arg,4))='B000' THEN
DO
SAY CR
SAY pen3'Error!'def arg 'is not allowed as a filename. Please try again.'CR
CALL waiting()
RETURN 1
END
x=LASTPOS('/',arg)
IF x=0 THEN x=LASTPOS(':',arg)
IF x>0 THEN
DO
IF DATATYPE(SUBSTR(arg,x+1),'W') THEN
DO
SAY CR
SAY pen3'Error!'def 'Whole numbers are not allowed as filenames!'CR
CALL waiting()
RETURN 1
END
END
tempnum=LENGTH(arg)-16
DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0
temp=' 'pen3||arg def'is'pen3 tempnum||def
IF tempnum=1 THEN temp=temp 'character'
ELSE temp=temp 'characters'
temp=temp 'too long for a filename.'
SAY temp||CR
arg=getinput(0 0 'Filename: ')
arg=cleanstring('0:'arg)
arg=COMPRESS(arg,' :/,;|#?*()+[]"{}')
tempnum=LENGTH(arg)-16
END
IF arg='' THEN RETURN 1
IF frommenu THEN
DO
IF is_here(arg) THEN RETURN 1
IF wi=999999 THEN RETURN 1
IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
ELSE
DO loop=1
SAY 'Please select an appropriate library for -' pen3||arg def'-'CR
temp=chdir()
IF temp=0 THEN LEAVE loop
IF temp=2 THEN RETURN 1
END
END
checkproto='T'
targ=arg
DO WHILE checkproto='T'
arg=''
SAY CR
SAY 'Library:'pen3 plaindir def' Filename:'pen3 targ def' Protocol:'pen3 protocol||def||CR
pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
pline=pline '['pen3'U'def']pload (qtU) > '
checkproto=getinput(1 1 pline)
IF checkproto='Q' THEN RETURN 1
IF checkproto='T' THEN CALL chpro()
END
arg=targ
CALL postuser(4)
CALL sound('UPLOAD')
uploadtime=TIME('E')
SAY 'Starting' protocol 'transfer. Press' pen3'Esc'def 'to abort.'CR
CALL whodat()
uldlflag=1
DownLoad arg
IF RC>0 THEN RETURN 2
IF bbsXferStats.baud(14 arg colorflag protocol) THEN RETURN 2
rbytes=WORD(STATEF(arg),2)
IF rbytes<1 THEN
DO
CALL DELETE(arg)
RETURN 2
END
temp=''
DO WHILE temp~='N' & temp~='Y'
temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
END
IF temp='N' THEN RETURN 2
IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
DO
SAY CR
SAY pen3'***'def arg pen3'failed archive check!'def||CR
SAY CR
temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
IF temp~='Y' THEN
DO
CALL DELETE(arg)
SAY CR
RETURN 2
END
END
CALL bytes2user(14 rbytes)
ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
IF bbsprefs.9 & name~=sysop THEN
DO
newufile=bbspath'EMail/'sysop'/NEW_FILES'
IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
ELSE
DO
ok=OPEN(f,newufile,'W')
IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***')
END
IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg' 'DATE() TIME())
CALL CLOSE(f)
END
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN
DO
uldlflag=0
RETURN 0
END
DO ui=sysoplevel+2 TO 100
IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0 /* no filenotes */
END
IF frommenu THEN
DO
uploadtime=TIME('E')-uploadtime
IF bbsprefs.11 THEN
DO
addtime=addtime+uploadtime
maxtime=maxtime+uploadtime
line='This session''s time has been increased by'
line=line TRUNC(uploadtime%60+.05,1)+2 'minutes.'
SAY CR
SAY line||CR
SAY 'Your ratio of bytes uploaded to bytes downloaded is 1:'ratio()||CR
END
CALL sound('NEW_FILE')
uldlflag=0
DO WHILE editnote(arg) /* INSIST on a filenote */
END
CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15)))
SAY pen3'Thank you for contributing to the' bbsname 'file libraries!'def||CR
END
uldlflag=0
waitchar=''
RETURN 0
ratio:
upbytes=WORD(data.14,3)
IF ~DATATYPE(upbytes,'W') | upbytes<1 THEN upbytes=1
dnbytes=WORD(data.15,3)
IF ~DATATYPE(dnbytes,'W') | dnbytes<1 THEN dnbytes=1
RETURN TRUNC((dnbytes/upbytes)+.5)
findfiles:
PARSE ARG ffile .
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
wi=0
IF DATATYPE(ffile,'W') THEN
DO
IF WORDS(files.ffile)<2 THEN RETURN 0
dirtemp=WORD(files.ffile,1)
IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
DO
CALL illegal_access()
RETURN 0
END
CALL setdir(libpath||dirtemp)
END
ELSE IF EXISTS(ffile) THEN
DO
IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
DO
IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
DO
line=READLN(f)
CALL CLOSE(f)
ffile=WORD(line,2)
END
END
END
ELSE IF EXISTS(bbspath'Information'ffile) THEN
RETURN bbspath'Information/'ffile
ELSE
DO
nextfilenum=countcheck('Numbers/LastFile' 0)+1
CALL busywait(4 1)
DO ni=nextfilenum TO 0 BY -1
IF ni<1 THEN
DO
CALL busywait(4 0)
SAY CR
SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR
SAY CR
RETURN 0
END
IF ni>1 THEN CALL busywait(60 ni nextfilenum)
argtemp=WORD(files.ni,2)
IF UPPER(argtemp)=UPPER(ffile) THEN
DO
dirtemp=WORD(files.ni,1)
jj=files.ni.0
IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
DO
CALL busywait(4 0)
CALL illegal_access()
RETURN 0
END
ffile=ni
CALL setdir(libpath||dirtemp)
LEAVE ni
END
END
CALL busywait(4 0)
END
IF wi=999999 THEN RETURN 0
ftemp=ffile
IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2)
IF ~EXISTS(ftemp) THEN
DO
finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
IF ~EXISTS(ftemp) THEN
DO
IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'CR
ELSE
DO
SAY CR
IF WORDS(finfo)<8 THEN ftemp=plaindir'/'ftemp
SAY '***'pen3 ftemp def'is not currently available online.'CR
SAY ' Would you like me to notify the sysop'CR
SAY ' that you''d like to receive this file?'CR
IF getinput(1 1 ' (Ny) > ')='Y' THEN
DO
enum=countcheck('Numbers/LastMail' 0)+1
CALL countcheck('Numbers/LastMail' enum)
IF writeopen(bbspath'email/'sysop'/'name'.'enum)=0 THEN RETURN
CALL WRITELN(f,' Mail: 'enum )
CALL WRITELN(f,' From: 'name)
CALL WRITELN(f,' To: 'sysop)
CALL WRITELN(f,' Subj: File Request')
CALL WRITELN(f,' Date: 'DATE()' 'TIME('C'))
x=RIGHT('File Request==',76,'=')
CALL WRITELN(f,x)
CALL WRITELN(f,' Mr. Sysop, I would like to have this file : ')
CALL WRITELN(f,' 'ftemp)
CALL WRITELN(f,' ')
CALL CLOSE(f)
SAY CR
ADDRESS AREXX bbsSpeak.rexx 'FILE_REQUEST' name bbspath saypath
SAY 'Your file request has been sent!'CR
SAY 'The file should be in your Email soon.'CR
END
SAY CR
END
RETURN 0
END
END
RETURN ffile
illegal_access:
SAY CR
SAY '*** You are not authorized to access' ffile'!'CR
SAY '*** Send Email to' sysop 'to receive a higher level.'CR
SAY CR
IF DATATYPE(ffile,'W') THEN ffile=ffile WORD(files.ffile,2)
CALL send2log('Illegal Access Attempt!' ffile 'in' dirtemp)
RETURN
statuscheck:
PARSE ARG ffile
updownratio=WORD(data.17,1)
IF ~DATATYPE(updownratio,'N') THEN updownratio=100
updn=ratio()
dbytes=WORD(STATEF(ffile),2)
IF ~DATATYPE(dbytes,'W') THEN dbytes=1
IF ~DATATYPE(bps,'W') THEN bps=2400
needtime=dbytes%(bps%10)+10 /* plus 10 seconds for handshaking? */
SAY CR
SAY CR
CALL showtime()
SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR
SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR
IF level>(sysoplevel+1) THEN RETURN 0
IF (needtime+TIME('E'))>maxtime THEN
DO
SAY CR
SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR
IF needtime>(WORD(data.11,1)*60) THEN
SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR
SAY CR
RETURN 1
END
IF updownratio>0 & updn>updownratio THEN
DO
SAY CR
line=pen3' *** You must upload before you do any more downloading! ***'def
SAY line||CR
SAY ' Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR
IF bbsprefs.4 THEN RETURN 1
SAY pen3' - This requirement is temporarily suspended. -'def||CR
SAY CR
END
RETURN 0
ext_dload:
SAY CR
CALL checkdcd()
allargs=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
IF allargs='' | TRUNC(maxtime-TIME('E'))<30 THEN RETURN
CALL dload2()
RETURN
dload:
arg=STRIP(arg data.25)
data.25=''
curdir=PRAGMA('D')
OPTIONS PROMPT 'File numbers (and/or names): '
IF arg='' THEN PARSE PULL arg /* no filename given */
IF arg='' THEN RETURN 0
allargs=TRANSLATE(arg,' ',':/,;|')
tempargs=SPACE(allargs,1)
numchk=1
DO ui=1 TO WORDS(tempargs) WHILE STRIP(allargs)~=''
arg=WORD(tempargs,ui)
IF ~DATATYPE(arg,'W') THEN numchk=0
wloc=WORDINDEX(allargs,FIND(allargs,arg))
wi=0
temp=findfiles(arg)
IF wi=999999 THEN RETURN 0
IF temp~=arg THEN
DO
allargs=DELWORD(allargs,FIND(allargs,arg),1)
IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1)
END
END
IF numchk=0 THEN
IF countcheck('Numbers/LastFile' 0)>500 THEN
DO
SAY LEFT('',20)||CR
SAY bak2' BBBBS Tip:'def' Next time try using fileNUMBERS instead of fileNAMES.'CR
SAY ' The BBS is MUCH faster at locating files by number.'CR
END
dload2:
curdir=PRAGMA('D')
allargs=STRIP(allargs data.25)
data.25=''
IF allargs='' THEN RETURN 0
sleepy='T'
DO WHILE sleepy='T'
arg=''
SAY LEFT('',20)||CR
temp=WORD(allargs,1)
IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
test=''
IF LENGTH(temp)>40 THEN
DO
test=temp
temp=''
END
SAY 'Filename(s)'pen3 LEFT(temp,40) def'Protocol:'pen3 protocol||def||CR
IF test~='' THEN SAY ' 'pen3 test||def||CR
DO di=2 TO WORDS(allargs)
temp=WORD(allargs,di)
IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
SAY ' 'pen3 temp||def||CR
END
pline='['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload'
pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)'
sleepy=getinput(1 1 pline '> ')
IF sleepy='Q' THEN RETURN 0
IF sleepy='A' THEN sleepy='LOGOFF'
IF sleepy='T' THEN CALL chpro()
END
DO WHILE allargs~=''
errorflag=0
extdir=''
arg=WORD(allargs,1)
allargs=STRIP(DELWORD(allargs,1,1))
IF DATATYPE(arg,'W') THEN
DO
CALL setdir(libpath||WORD(files.arg,1))
arg=WORD(files.arg,2)
END
notename=bbspath'FileNotes/'plaindir'/'arg
finfo=''
IF ~EXISTS(arg) THEN
DO
finfo=STATEF(notename)
IF WORDS(finfo)>7 THEN
DO
temp=plaindir
x=lastslash(WORD(finfo,8))
arg=WORD(x,1)
CALL setdir(WORD(x,2))
plaindir=temp
END
END
x=lastslash(arg)
IF WORDS(x)>1 THEN
DO
arg=WORD(x,1)
extdir=WORD(x,2)
CALL setdir(extdir)
END
uldlflag=1
DO dloadloop=1
IF statuscheck(arg) THEN
DO
errorflag=1
LEAVE dloadloop
END
CALL postuser(5)
CALL sound('DOWNLOAD')
SAY 'Starting' protocol 'transfer. Press' pen3'Esc'def 'to abort.'CR
CALL checktime()
UpLoad arg
IF RC>0 | bbsXferStats(15 arg colorflag protocol extdir) THEN
DO
errorflag=1
LEAVE dloadloop
END
CALL bytes2user(15 WORD(STATEF(arg),2))
IF extdir='' & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 THEN
DO dloadloop2=1 TO 1
DO di=sysoplevel+2 TO 100
IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop2
END
IF readlines(notename 1) THEN
DO
CALL send2log('Unable to increment download count for' plaindir'/'arg)
LEAVE dloadloop2
END
dls=WORD(lynes.2,7)
IF ~DATATYPE(dls,'W') THEN dls=0
lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
finfo=STATEF(notename)
IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
ELSE finfo=''
CALL DELETE(notename)
CALL savelines(notename)
CALL DELAY(28)
IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' notename finfo
IF WORD(data.16,1)<WORD(lynes.1,2) THEN
DO
lastbrowse=WORD(lynes.1,2)
newfilesdate=DATE('S') TIME()
END
END
LEAVE dloadloop
END
END
uldlflag=0
CALL setdir(curdir)
IF errorflag THEN SAY pen3'*** Download Failed!'def||CR
IF sleepy='LOGOFF' THEN
DO
SAY CR
SAY 'Logging'pen3 'OFF' def'in 10 seconds...'CR
SAY 'Press'pen3 RETURN def'to return to'pen3 bbsname||def||CR
SAY CR
Timeout 10
WAIT '?'
t=RC
Timeout maxidle
IF t~=0 THEN SIGNAL LOGOUT2
END
RETURN errorflag
lastslash:
PARSE ARG sarg
sdir=''
slash=LASTPOS('/',sarg)
IF slash>2 THEN sdir=LEFT(sarg,slash-1)
ELSE
DO
slash=LASTPOS(':',sarg)
IF slash>0 THEN sdir=LEFT(sarg,slash)
END
IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
RETURN sarg sdir
editnote:
IF arg='' THEN
DO
PARSE PULL arg .
IF arg='' THEN RETURN 0
END
comment=''
IF ~EXISTS(arg) THEN
DO
finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
temp=''
IF WORDS(finfo)>7 THEN comment=WORD(finfo,8)
ELSE
DO
IF level<sysoplevel THEN RETURN 0
temp=getinput(1 1 'Is this file on an another device? (Nqy)')
END
IF temp='Y' THEN
DO WHILE comment=''
comment=getinput(0 0 'Enter linkfile using full dev:path/filename > ')
IF comment='' THEN RETURN 0
IF ~EXISTS(comment) THEN comment=''
END
ELSE IF temp='Q' THEN RETURN 0
END
IF comment='' THEN
DO
arg=findfiles(arg)
IF arg=0 THEN RETURN 0
IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2)
END
filedir=plaindir
CALL MAKEDIR(bbspath'FileNotes/'filedir)
IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
DO
SAY pen3'*** Failed to open directory!' filedir||def||CR
RETURN 0
END
notename=bbspath'FileNotes/'filedir'/'arg
lynes.=''
filenum=countcheck('Numbers/LastFile' 0)
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=5
IF EXISTS(notename) THEN
DO
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
CALL bbsEd.rexx(firstedit notename name TRUNC(maxtime-TIME('E'))-28)
CALL checkfilechanges()
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
RETURN 0
END
IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
ELSE filedata=STATEF(comment)
IF filedata='' THEN
DO
IF comment='' THEN line=filedir'/'arg
ELSE line=comment
SAY line 'does not exist!'CR
RETURN 0
END
bytes=WORD(filedata,2)
filenum=filenum+1
lynes.0=4
lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes Downloads: 0'
lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')' Lib: 'filedir
lynes.4=LEFT('',74,'=')
lynes.1=lynes.1 edkeywords(arg filedir)
diz='RAM:file_id.diz'
IF EXISTS(diz) THEN CALL readlines(diz 5)
CALL DELETE(diz)
CALL seelines(1)
edtype=''
CALL writebuffer(scratch'/NoteFile')
IF savelines(notename) THEN RETURN 0
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
CALL DELETE(libpath||filedir'/.'STRIP(LEFT(filedir,15)))
fncom='R'
DO WHILE fncom='R'
CALL seelines(1)
nonstop=0
line='['pen3'E'def']dit'
IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
line=line '['pen3'R'def']ead ['pen3'S'def']ave'
IF level>sysoplevel THEN line=line '(ekrS) 'def
ELSE line=line '(erS) 'def
fncom=getinput(1 1 line)
IF fncom='K' & level>sysoplevel THEN
DO
SAY 'Killing FileNote..'CR
CALL DELETE(notename)
RETURN 1
END
ELSE IF fncom='E' THEN
DO
IF bbsEd.rexx(firstedit notename name TRUNC(maxtime-TIME('E'))-28)>0 THEN RETURN 0
CALL readlines(notename 1)
CALL checkfilechanges()
fncom='R'
END
ELSE IF fncom~='R' THEN
DO
SAY 'Adjusting filelist...'CR
IF filenum<1 THEN filenum=1
IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1)
CALL countcheck('Numbers/LastFile' filenum)
files.0=files.0+1
newcount=alpha.0+1
alpha.0=newcount
files.filenum=plaindir arg
files.filenum.0=newcount
libnum=finddirnum(plaindir)
PARSE VAR lynes.1 . 'KeyWords:' keywords
alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
IF EXISTS(bbspath'Lists/Files') THEN
x=listOPEN(f,bbspath'Lists/Files','A')
ELSE x=listOPEN(f,bbspath'Lists/Files','W')
IF x=0 THEN
DO
SAY '*** Failed to open' bbspath'Lists/Files'CR
savefileflag=1
RETURN 0
END
CALL WRITELN(f,filenum files.filenum)
CALL CLOSE(f)
IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
x=listOPEN(f,bbspath'Lists/Files.ALPHA','A')
ELSE x=listOPEN(f,bbspath'Lists/Files.ALPHA','W')
IF x=0 THEN
DO
SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'CR
RETURN 0
END
CALL WRITELN(f,alpha.newcount)
CALL CLOSE(f)
IF EXISTS('c:shellsort') THEN loadalphaflag=1
ELSE sortalphaflag=1
CALL cleanline(1)
END
END
RETURN 0
checkfilechanges:
x=GETCLIP('BBS_FileChange')
CALL SETCLIP('BBS_FileChange')
DO ii=1 TO WORDS(x)
fnum=WORD(x,ii)
keywords=GETCLIP('BBS_Keywords_'fnum)
CALL SETCLIP('BBS_Keywords_'fnum)
num=files.fnum.0
alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
sortalphaflag=1
END
RETURN
edkeywords:
PARSE ARG kwarg
templine=''
DO WHILE LENGTH(templine)<3
SAY CR
SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
SAY ' Note that only the first 32 characters will be used.'CR
SAY LEFT('',43)'|'LEFT('',31,'=')'|'CR
templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
templine=cleanstring('0:'templine)
templine=STRIP(LEFT(templine,32))
SAY CR
END
RETURN templine
loadfiles:
SAY def||CR
IF ~listOPEN(f,bbspath'Lists/Files','R') THEN RETURN
SAY 'Loading filelist...'CR
files.=''
files.0=0
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
num=WORD(line,1)
IF DATATYPE(num,'W') THEN
DO
IF num<100 THEN
IF LEFT(WORD(line,3),1)~='.' THEN
DO
CALL CLOSE(f)
SAY CR
SAY 'Your filelists need to be renumbered, running bbsUPDATE.rexx...'CR
CALL bbsUPDATE.rexx()
SIGNAL RESET
END
files.num=WORD(line,2) WORD(line,3)
END
END
files.0=i-1
CALL CLOSE(f)
RETURN
savefilelist:
IF level=99 THEN
IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN
savefilelist2:
SIGNAL OFF BREAK_E
CALL savealphalist()
filenum=countcheck('Numbers/LastFile' 0)
IF filenum<1 THEN
DO
IF lastfile>0 THEN filenum=lastfile+100
ELSE RETURN
END
xarg=bbspath'Lists/Files'
IF ~listOPEN(f,xarg,'W') THEN RETURN
SAY 'Saving filelist...'CR
savefileflag=0
DO i=1 TO filenum
IF files.i~='' THEN CALL WRITELN(f,i files.i)
END
CALL CLOSE(f)
IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
RETURN
loadalpha:
ARG alflag
SAY def||CR
IF alflag THEN CALL checkliblists()
IF liblist='' THEN alflag=0
IF loadalphaflag=1 THEN
DO
SAY 'Sorting using fast shellsort...'CR
t=bbspath'Lists/Files.ALPHA'
ADDRESS COMMAND 'c:shellsort -c' t t
END
IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','R') THEN RETURN
SAY 'Loading the alphabetical filelist...'CR
loadalphaflag=0
alpha.=''
alpha.0=0
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
fnum=WORD(line,3)
IF DATATYPE(fnum,'W') THEN
DO
alpha.i=line
files.fnum.0=i
IF alflag THEN CALL updateliblists()
END
ELSE i=i-1
END
CALL CLOSE(f)
tf=bbspath'Lists/Files.ALPHA.add'
IF EXISTS(tf) & ~SHOW('P','BBSFILE') THEN
IF readopen(tf) THEN
DO
DO i=i
line=READLN(f)
IF EOF(f) THEN LEAVE i
fnum=WORD(line,3)
IF DATATYPE(fnum,'W') THEN
DO
alpha.i=line
files.fnum.0=i
END
ELSE i=i-1
IF alflag THEN CALL updateliblists()
END
CALL CLOSE(f)
CALL DELETE(tf)
CALL SETCLIP('BBS_resave_local',1)
END
alpha.0=i-1
IF alflag THEN CALL closeliblists()
DO i=1 TO 99
IF dirs.i='' THEN ITERATE i
dname='.'STRIP(LEFT(dirs.i,15))
IF files.i='' THEN
DO
files.i=dirs.i dname
files.0=files.0+1
END
sz=WORD(STATEF(libpath||dirs.i'/'dname),2)
IF ~DATATYPE(sz,'W') THEN sz=0
x=files.i.0
IF ~DATATYPE(x,'W') THEN
DO
x=alpha.0+1
files.i.0=x
alpha.0=x
CALL SETCLIP('BBS_resave',1)
CALL DELETE(libpath||dirs.i'/'dname)
END
alpha.x=LEFT(dname,22-LENGTH(sz)) sz RIGHT(i,5) RIGHT(i,2)
alpha.x=alpha.x LEFT(dirs.i,12) 'alphabetical files list CONTENTS'
END
IF GETCLIP('BBS_resave')=1 THEN
DO
CALL SETCLIP('BBS_resave')
sortalphaflag=1
CALL savefilelist2()
END
IF alpha.0<files.0 THEN buildalpha=1
SAY CR
RETURN
savealphalist:
SIGNAL OFF BREAK_E
IF GETCLIP('BBS_localfiles')~='' THEN
DO
CALL SETCLIP('BBS_localfiles')
CALL loadfiles()
CALL loadalpha(0)
END
CALL checkliblists()
IF sortalphaflag=1 THEN
DO
SAY 'Alphabetizing' alpha.0 'files...'CR
IF alpha.0>0 THEN CALL QSORT(1,alpha.0,alpha)
DO i=1 TO alpha.0
fnum=WORD(alpha.i,3)
files.fnum.0=i
END
END
sortalphaflag=0
IF files.100~='' THEN
DO
sz=WORD(STATEF(libpath||WORD(files.100,1)'/'WORD(files.100,2)),2)
IF DATATYPE(sz,'W') THEN
DO
anum=files.100.0
alpha.anum=OVERLAY(RIGHT(sz,7),alpha.anum,17,7)
END
END
IF files.101~='' THEN
DO
sz=WORD(STATEF(libpath||WORD(files.101,1)'/'WORD(files.101,2)),2)
IF DATATYPE(sz,'W') THEN
DO
anum=files.101.0
alpha.anum=OVERLAY(RIGHT(sz,7),alpha.anum,17,7)
END
END
IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','W') THEN RETURN
SAY 'Saving alphabetical filelists...'CR
DO i=1 TO alpha.0
ii=WORD(alpha.i,3)
IF files.ii='' THEN alpha.i='0 0' ii '100'
IF LEFT(alpha.i,4)='0 0 ' THEN ITERATE i
CALL WRITELN(f,alpha.i)
IF liblist~='' THEN CALL updateliblists()
END
CALL CLOSE(f)
CALL closeliblists()
CALL bbsALPHA.rexx(files.0 SUBSTR(extension,2) arccom)
DO i=0 TO 1
t=GETCLIP('BBS_10'i)
IF t='' THEN ITERATE i
CALL SETCLIP('BBS_10'i)
num=100+i
files.num=TRANSLATE(t,,'/')
files.0=files.0+1
x=alpha.0+1
files.num.0=x
alpha.0=x
sz=WORD(STATEF(libpath||t),2)
IF ~DATATYPE(sz,'W') THEN sz=0
dnum=finddirnum(WORD(files.num,1))
alpha.x=LEFT(WORD(files.num,2),22-LENGTH(sz)) sz ' 'num RIGHT(dnum,2)
alpha.x=alpha.x LEFT(dirs.dnum,12)
IF i THEN alpha.x=alpha.x 'alphabetical files list CONTENTS'
ELSE alpha.x=alpha.x 'alphabetical by library CONTENTS'
SAY 'Added file' num t 'to the filelists.'CR
SAY 'Must now resort and resave.'CR
CALL SETCLIP('BBS_resave',1)
END
RETURN
listOPEN:
PARSE ARG fh,listfile,flag
DO i=0 TO 59 WHILE OPEN(fh,listfile,flag)=0
IF i//4=0 THEN SAY 'Waiting' (60-i)*5 'more seconds for' listfile 'to become available...'CR
CALL DELAY(250)
END
IF i>59 THEN
DO
line='*** unable to access' listfile 'list.'
SAY line||CR
CALL send2log(line TIME())
RETURN 0
END
RETURN 1
checkliblists:
SAY 'Checking individual library filelists...'CR
liblist=''
lastlib=0
cnt.=0
DO i=1 TO 99
IF dirs.i='' THEN ITERATE i
finfo=STATEF(libpath||dirs.i'/.'STRIP(LEFT(dirs.i,15)))
IF finfo='' THEN liblist=liblist i
ELSE
DO
sz=WORD(finfo,2)
num=files.i.0
IF DATATYPE(num,'W') THEN
alpha.num=OVERLAY(RIGHT(sz,7),alpha.num,17,7)
END
END
liblist=STRIP(liblist)
DO j=1 TO WORDS(liblist)
tt=WORD(liblist,j)
CALL MAKEDIR(libpath||dirs.tt)
lf1=libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15))
flg='W'
IF EXISTS(libpath||dirs.tt'.txt') THEN
DO
ADDRESS COMMAND 'COPY' libpath||dirs.tt'.txt' lf1
flg='A'
END
IF listOPEN(f,lf1,flg)=0 THEN ITERATE j
IF flg='A' THEN CALL WRITELN(f,'')
CALL WRITELN(f,'Filename Bytes File# Library KeyWords')
CALL WRITELN(f,LEFT('=',77,'='))
CALL CLOSE(f)
END
RETURN
updateliblists:
x=FIND(liblist,WORD(alpha.i,4))
IF x=0 THEN RETURN
tt=WORD(liblist,x)
IF tt~=lastlib THEN
DO
CALL CLOSE(a)
lastlib=tt
x=OPEN(a,libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15)),'A')
IF x=0 THEN
DO
lastlib=0
RETURN
END
END
CALL WRITELN(a,alpha.i)
cnt.tt=cnt.tt+1
RETURN
closeliblists:
CALL CLOSE(a)
DO i=1 TO WORDS(liblist)
tt=WORD(liblist,i)
dname='.'STRIP(LEFT(dirs.tt,15))
SAY ' 'dname||CR
x=OPEN(f,libpath||dirs.tt'/'dname,'A')
IF x~=0 THEN
DO
CALL WRITELN(f,LEFT('-',77,'-'))
temp='file'
IF cnt.tt~=1 THEN temp=temp's'
temp=cnt.tt temp'. Last updated' DATE() 'at' TIME('C')
temp=temp RIGHT(bbsname,76-LENGTH(temp))
CALL WRITELN(f,temp)
CALL CLOSE(f)
END
CALL MAKEDIR(bbspath'FileNotes/'dirs.tt)
fnote=bbspath'FileNotes/'dirs.tt'/'dname
lynes.=''
lynes.0=5
x=OPEN(f,fnote,'R')
IF x=0 THEN CALL SETCLIP('BBS_resave',1)
ELSE
DO
DO k=1
line=READLN(f)
IF EOF(f) THEN LEAVE k
lynes.k=line
END
CALL CLOSE(f)
lynes.0=k-1
END
finfo=STATEF(libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15)))
bt=WORD(finfo,2)
dl=WORD(lynes.2,7)
IF ~DATATYPE(dl,'W') THEN dl=0
lynes.1='File: 'LEFT(tt,5)' KeyWords: alphabetical files list CONTENTS'
lynes.2='Name: 'LEFT(dname,27)' Size:' bt 'bytes Downloads:' dl
lynes.3='From: 'LEFT('BBBBS',27)' Date: 'DATE() TIME('C')' Lib: 'dirs.tt
lynes.4=LEFT('',74,'=')
IF lynes.5='' THEN
lynes.5='Up to the minute alphabetical filelist of the' dirs.tt 'library.'
IF writeopen(fnote) THEN
DO
DO k=1 TO lynes.0
CALL WRITELN(f,lynes.k)
END
CALL CLOSE(f)
SAY LEFT(' ',LENGTH(dname)+2)'1B'x'Mupdated.'CR
END
END
liblist=''
RETURN
edituser:
SAY lm
x=bbsEditUser.rexx(TRUNC(maxtime-TIME('E'))-28 name)
CALL loaddata()
IF x=1 THEN CALL sortconferences()
RETURN
setmsgs:
IF ~DATATYPE(bbsprefs.25,'W') THEN RETURN
data.22=''
data.23=''
SAY CR
line='Setting message counters to last'
IF bbsprefs.25>1 THEN line=line bbsprefs.25 'messages'
ELSE line=line 'message'
line=line 'in each conference...'
SAY line||CR
DO i=1 TO level
num=countcheck('Numbers/LastMessage'i 0)-bbsprefs.25
IF num<0 | msg.i.0<bbsprefs.25 THEN num=0
lastread.i=num
data.22=data.22 num
data.23=data.23 0
END
SAY 'Setting file counter to last file uploaded...'CR
lastbrowse=countcheck('Numbers/LastFile' 0)
newfilesdate=DATE('S') TIME()
RETURN
getnumber:
PARSE ARG tprompt
tnum=getinput(1 0 ' 'tprompt' > ')
mask=COMPRESS(XRANGE(),'0123456789')
tnum=COMPRESS(tnum,mask)
IF ~DATATYPE(tnum,'W') THEN tnum=0
tnum=tnum%1
IF tnum>0 & tnum<10 THEN tnum='0'tnum
RETURN tnum
getbirth:
data.12=WORD(data.12,1)' 'WORD(data.12,2)' Birthday:'
SAY pen3'Birthday Information:'def||CR
month=getnumber('Please enter the MONTH you were born: (1-12)')
day=getnumber('Please enter the DAY you were born: (1-31)')
year=getnumber('Please enter the YEAR you were born: ')
IF year<100 THEN year=year+1900
born=year||month||day
IF born<18750101 | born>(DATE('S')-50000) THEN /* must be older than 4 */
DO
born=''
IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
CALL getbirth()
END
data.12=WORD(data.12,1)' 'WORD(data.12,2)' 'WORD(data.12,3)' 'WORD(born,1)
RETURN
getname:
nonstop=0
CALL showuserlist()
SAY CR
waitchar='Q'
CALL showtext(bbspath'BBS_TEXT/NEW_USER_NAME' 1)
pline='Your name on'pen3 bbsname def'will be > '
name=getinput(1 0 pline)
name=cleanstring(1':'name)
IF name='' THEN
DO
name=getinput(1 0 pline)
name=cleanstring(1':'name)
IF name='' THEN
DO
SAY 'No name, no entry. Bye!'CR
SIGNAL DONE
END
END
IF EXISTS(bbspath'Users/'name) | FIND(exclusion,name)>0 THEN
DO
SAY 'Sorry! That name is taken. Please try again.'CR
RETURN 1
END
IF LENGTH(name)=1 THEN
DO
SAY 'One letter names are not allowed,' name', please try again.'CR
RETURN 1
END
IF getinput(1 1 'Your name on'pen3 bbsname def'will be >' name', is that correct? (nY) > ')='N' THEN
RETURN 1
RETURN 0
/** see if name is in data */
checkUser:
tries=0
IF name='NEW' THEN
DO
name=''
DO WHILE getname()
END
CALL postuser(7)
END
IF ~EXISTS(bbspath'Users/'name) THEN
DO
IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
DO
nonstop=0
CALL showtext(bbspath'BBS_TEXT/NEW' 1)
END
SAY CR
IF getinput(1 1 'Do you want to register? (nY) > ')='N' THEN
DO
SAY 'Thanks anyway, bye!'CR
line=name 'did not want to register.'
SIGNAL OUT2
END
defile=bbspath'BBS_TEXT/DEF.NEW_USER'
CALL loadcourtesy()
wordnum=FIND(courtesy,name)
IF wordnum>0 THEN
DO
SAY name', is on the Courtesy List. You will be granted immediate access.'CR
courtesy=STRIP(DELWORD(courtesy,wordnum,1))
IF writeopen(bbspath'Lists/Courtesy') THEN
DO
DO i=1 TO WORDS(courtesy)
CALL WRITELN(f,WORD(courtesy,i))
END
CALL CLOSE(f)
END
defile=bbspath'BBS_TEXT/DEF.COURTESY'
END
ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'CR
IF readlines(defile 1) THEN SIGNAL DONE
CALL sound('NEW_USER')
data.=''
data.0=27
DO i=6 TO 22
data.i=lynes.i
END
data.12=DATE('S')' 'TIME('C')
data.13=data.12
lastondate=DATE('I')-1
lastontime=TIME('C')
x=FIND(UPPER(data.8),'COLOR')
test=getinput(1 1 'Do you see colors ('pen3'ANSI' pen2'C'pen3'O'pen5'L'pen6'O'pen7'R' pen3'codes'def') on this line? (nY) > ')
IF test='N' THEN
DO
IF x>0 THEN data.8=DELWORD(data.8,x,1)
CALL colors(0)
END
ELSE IF x=0 THEN
DO
data.8=data.8 'COLOR'
CALL colors(1)
END
DO i=60 TO 0 BY -1
SAY RIGHT('- 'i' -',14)||CR
END
data.7=getinput(1 0 'What number is now at the top of your screen? > ')
IF data.7<17 | data.7>75 THEN data.7=20
SAY 'Please enter the password you would like to use here.'CR
data.5=getinput(1 0 'Enter Password: ')
DO WHILE getinput(1 1 'Your password on' bbsname 'will be :' data.5 ', is that correct? (nY) > ')='N'
data.5=getinput(1 0 'Enter Password: ')
END
IF data.5='' THEN
DO
line=name 'refused to enter a password.'
SIGNAL DONE
END
data.1=''
DO WHILE data.1=''
data.1=getinput(0 0 'Full (real) Name: ')
IF data.1='' THEN SAY 'You MUST leave your real name!'CR
END
data.2=getinput(0 0 'Street: ')
data.3=getinput(0 0 'City, State Zip: ')
data.4=''
DO WHILE data.4=''
data.4=getinput(0 0 'Voice Phone (including areacode): ')
IF data.4='' THEN
SAY sysop 'MUST be able to reach you by phone to validate you!'CR
END
CALL getbirth()
IF bbsprefs.8 THEN
DO
newufile=bbspath'Lists/NEW_USERS'
IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
ELSE
DO
ok=OPEN(f,newufile,'W')
IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
END
IF ok~=0 THEN
DO
temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
temp=temp LEFT(name,24)'=' data.1' 'data.4
CALL WRITELN(f,temp)
END
CALL CLOSE(f)
END
data.9=getinput(0 0 'Computer: ')
data.10=getinput(0 0 'Interests: ')
test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
IF test='Y' THEN data.8=data.8 'STREET'
test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
IF test='Y' THEN data.8=data.8 'PHONE'
IF bbsprefs.7>0 THEN
DO
data.20=bbsprefs.7
CALL do_eleven(60 bbsprefs.16 bbsprefs.16-1)
END
SAY CR
CALL setdata()
IF data.20=0 THEN
SAY 'Thank you, the sysop will give you higher access soon.'CR
ELSE CALL setmsgs()
SAY CR
SAY 'Please feel free to leave additional info by using [C]omment.'CR
SAY CR
CALL savedata(1)
SAY 'Adding' name 'to the user list...'CR
newpassword=data.5
sortuserflag=1
temp=countcheck('Numbers/Users' 0)+1
CALL countcheck('Numbers/Users' temp)
END
ELSE
DO
IF loaddata()=0 THEN SIGNAL DONE
city=docity(data.3)
PARSE VAR data.11 amins . . . ttimes . . . atimes .
lastondate=DATE('I',WORD(data.13,1),'S')
lastontime=WORD(data.13,2)
IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=ttimes
IF level=99 & amins<120 THEN amins=120
data.13=DATE('S')' 'TIME()
CALL do_eleven(amins ttimes atimes-1)
IF atimes<1 & DATE('I')=lastondate THEN
DO
SAY CR
SAY CR
line= 'Too many calls today. Call tomorrow.'
SAY line||CR
SAY CR
SAY CR
CALL send2log(line)
IF atimes<(-1) THEN SIGNAL LOGOUT2
ELSE SIGNAL LOGOUT
END
data.13=DATE('S')' 'TIME('C')
SAY CR
SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR
SAY CR
passprompt='Enter Password:
'
DO tries=1 TO 3
Send passprompt
Remote OFF
OPTIONS PROMPT ''
newpassword=getinput(1 0 '')
Remote ON
IF(password=newpassword) THEN
DO
SAY ''CR
LEAVE tries; /* correct password */
END
IF tries=3 THEN
DO /* 3 tries, hang up */
SAY ''CR
SAY 'Access terminated.'CR
line='*** Bad password ***' newpassword '***'
SAY line||CR
city=line
CALL postuser(6)
SIGNAL OUT2
END
SAY ''lineup' 'CR
passprompt='Incorrect. Password: ' /* ask again */
END
END
SAY CR
IF bbsprefs.23=1 THEN
ADDRESS AREXX bbsSpeak.rexx 'LOGON' name bbspath saypath
RETURN
do_eleven:
ARG am tc at .
data.11=am 'minutes per call,' tc 'calls per day,'
data.11=data.11 at 'more calls today'
RETURN
savedata:
ARG messflag .
IF data.5='' THEN RETURN
temp=GETCLIP(name'_UPDATE')
IF temp~='' THEN
DO
CALL SETCLIP(name'_UPDATE')
PARSE VAR temp upfiles' 'upbytes' 'upmail' 'upmsg
IF upfiles>0 THEN
DO
files=WORD(data.14,1)
bytes=WORD(data.14,3)
IF DATATYPE(files,'W') THEN upfiles=upfiles+files
IF DATATYPE(bytes,'W') THEN bytes=upbytes
data.14=upfiles 'files' bytes 'bytes.' DATE()
END
IF upmail>0 THEN
DO
mail=WORD(data.17,2)
IF DATATYPE(mail,'W') THEN upmail=upmail+mail
data.17=WORD(data.17,1) upmail WORD(data.17,3)
END
IF upmsg~='' THEN
DO
temp=data.23
DO i=1 TO level
smsg=WORD(temp,i)
IF ~DATATYPE(smsg,'W') THEN smsg=0
IF FIND(upmsg,i) THEN smsg=smsg+1
data.23=data.23 smsg
END
END
END
SAY 'Updating... 'lineup||CR
SIGNAL OFF BREAK_E
Status Trans
data.6=STRIP(RESULT)
IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
ELSE IF lastbrowse>0 THEN
DO
IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
ELSE data.16=DATE('S') TIME()
data.16=lastbrowse data.16
END
IF DATATYPE(winnings,'N') THEN data.18=winnings
ELSE data.18=0
IF messflag THEN
DO
userexclude.=0
DO si=1 TO WORDS(data.22)
IF WORD(data.22,si)=-1 THEN userexclude.si=1
END
data.22=''
data.23=''
DO si=1 TO level
IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0
IF userexclude.si THEN data.22=data.22 '-1'
ELSE data.22=data.22 lastread.si
IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0
data.23=data.23 totwrit.si
END
END
IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
IF data.0<27 THEN data.0=27
DO i=1 TO data.0
CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User' name 'has been updated.'CR
RETURN
loaddata:
IF name='' THEN RETURN 0
IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
data.=''
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
data.i=line
END
data.0=i-1
CALL CLOSE(f)
winnings=WORD(data.18,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0
setdata:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
lastbrowse=WORD(data.16,1)
IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0
level=data.20
DO i=1 TO level
lastread.i=WORD(data.22,i)
IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0
totwrit.i=WORD(data.23,i)
IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0
END
password=data.5
IF data.6='' THEN
DO
Status Trans
data.6=RESULT
END
ELSE
DO
IF RIGHT(UPPER(data.6),2)='-G' THEN data.6='G'
IF RIGHT(UPPER(data.6),3)='-1K' THEN data.6='K'
IF LEFT(UPPER(data.6),1)='A' THEN data.6='Z'
Set UPPER(LEFT(data.6,1))
END
IF ~DATATYPE(data.7,'W') THEN data.7=20
IF data.7<5 THEN data.7=5
linesperpage=data.7
IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
ELSE terseflag=0
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
CALL colors(colorflag)
IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x
ELSE clr=''
menu='ALL'
IF FIND(UPPER(data.8),'MENUS')>0 THEN
DO
menuflag=1
menu='MAIN'
END
ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
ELSE menuflag=0
IF level=0 THEN menu='NEW'
IF DATATYPE(WORD(data.11,3),'W') THEN
DO
PARSE VAR data.11 amins . atimes .
CALL do_eleven(amins bbsprefs.16 atimes)
END
data.21=UPPER(data.21)
maxtime=WORD(data.11,1)*60+addtime
CALL MAKEDIR(bbspath'Friends')
alias.=''
alias.0=0
realname.=''
CALL CLOSE(f)
IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
alias.i=WORD(line,1)
realname.i=WORD(line,2)
END
alias.0=i-1
CALL CLOSE(f)
RETURN 1
switchmenuflag:
IF menuflag=1 THEN
DO
menuflag=0
noff='OFF'
END
ELSE
DO
menuflag=1
noff='ON'
END
SAY 'Menus turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR
RETURN
switchcolors:
IF colorflag=1 THEN
DO
colorflag=0
noff='OFF'
END
ELSE
DO
colorflag=1
noff='ON'
END
CALL colors(colorflag)
SAY 'Color turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR
RETURN
/* ANSI pen color codes */
colors:
ARG onoff
IF onoff THEN
DO
def=''; /* default */
pen0='
'; pen1='
'; pen2='
'; pen3='
'
pen4='
'; pen5='
'; pen6='
'; pen7='
'
bak0='
'; bak1='
'; bak2='
'; bak3='
'
bak4='
'; bak5='
'; bak6='
'; bak7='
'
END
ELSE
DO
pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
def=''
END
RETURN
chpro:
arg=UPPER(LEFT(arg,1))
IF(arg='') THEN
DO
SAY CR
SAY '['pen3'W'def']- WXModem'CR
SAY '['pen3'X'def']- XModem-CRC'CR
SAY '['pen3'K'def']- XModem-1K'CR
SAY '['pen3'Y'def']- YModem'CR
SAY '['pen3'G'def']- YModem-G'CR
SAY '['pen3'Z'def']- ZModem'CR
SAY CR
arg=getinput(1 0 STRIP(protocol) '> ')
END
IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
Set arg
Status Transfer
protocol=STRIP(RESULT)
SAY protocol||CR
RETURN
sortinfofiles:
infolist=SHOWDIR(bbspath'Information')
IF infolist='' THEN
DO
SAY CR
SAY pen3'No files are currently in the Information drawer.'def||CR
SAY CR
RETURN 1
END
IF ~DATATYPE(sortinfo.0,'W') THEN
DO
info.=''
sortinfo.=''
info.0=WORDS(infolist)
DO i=1 TO info.0
info.i=WORD(infolist,i)
END
SAY 'Sorting..'CR
IF info.0>0 THEN CALL QSORT(1,info.0,info)
sortinfo.0=info.0%3
IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
DO i=1 TO sortinfo.0
sortinfo.i=''
DO j=0 TO 2
k=i+j*sortinfo.0
IF k<=info.0 THEN
DO
sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
infocount=WORD(STATEF(bbspath'Information/'info.k),8)
sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
END
END
END
SAY lineup' 'lineup||CR
END
RETURN 0
information:
IF sortinfofiles() THEN RETURN
CALL sound('INFO')
num=1
readcount=-1
DO infoloop=1
CALL postfour(' Information: Menu')
IF num=0 THEN
DO
IF readcount~=-1 THEN
DO
sortinfo.0=''
IF sortinfofiles() THEN RETURN
END
SAY CENTER('- Number of accesses per file -',75)||CR
END
ELSE SAY pen3'These text files are available for reading online...'def||CR
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO sortinfo.0
IF num=0 THEN SAY sortinfo.i.0||CR
ELSE SAY sortinfo.i||CR
END
SAY pen3||LEFT('-',75,'-')||def||CR
CALL checktime()
IF num=0 THEN
DO
CALL waiting()
num=1
ITERATE infoloop
END
num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
IF num=0 THEN ITERATE infoloop
IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN
readcount=STATEF(bbspath'Information/'info.num)
readbytes=WORD(readcount,2)
SAY ' 'info.num 'is' readbytes 'bytes.'CR
CALL postfour('Information:' info.num)
IF getinput(1 1 '['pen3'R'def']ead or ['pen3'D'def']ownload? (dR) > ')='D' THEN
DO
allargs=bbspath'Information/'info.num
CALL dload2()
END
ELSE
DO
SAY 'Loading File...'CR
CALL Increment.rexx(bbspath'Information/'info.num)
CALL DELAY(28)
CALL readlines(bbspath'Information/'info.num 1)
CALL cleanline(0)
SAY lineup' 'lynes.0 'lines.'CR
SAY CR
CALL seelines(0)
END
CALL showtime()
IF waitchar~='Q' THEN CALL waiting()
nonstop=0
END
RETURN
newfiles:
SAY CR
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
IF chdir()>0 THEN RETURN
SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR
lastbrowz=WORD(data.16,1)
lastfile=countcheck('Numbers/LastFile' 0)
newfiles2:
IF lastbrowz>=lastfile THEN
DO
lastbrowz=0
SAY pen3'No new files. Listing backwards by date from last file uploaded...'def||CR
END
ELSE newfilesflag=1
j=0
IF test='Y' THEN
DO
filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))-1
CALL busywait(4 1)
END
DO ni=lastfile TO lastbrowz+1 BY -1
IF files.ni~='' THEN
DO
IF test='Y' THEN
DO
IF ni>1 THEN CALL busywait(60 ni lastfile-lastbrowz)
IF j>=filecount THEN LEAVE ni
IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
ITERATE ni
END
jj=files.ni.0
IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
ITERATE ni /* unauthorized */
IF test='Y' THEN CALL busywait(4 0)
j=j+1
IF j=1 THEN CALL fileheader()
SAY alpha.jj||CR
IF (j+2)//(linesperpage-1)=0 THEN
IF waiting2() THEN LEAVE ni
IF test='Y' THEN CALL busywait(4 1)
END
END
IF test='Y' THEN CALL busywait(4 0)
IF j//linesperpage~=0 THEN CALL waiting()
IF j=0 & newfilesflag=1 THEN
DO
lastbrowz=999999
newfilesflag=0
CALL newfiles2()
END
IF test~='Y' THEN
DO
CALL newinfo()
IF lynes.0>0 THEN CALL waiting()
END
nonstop=0
RETURN
newinfo:
lynes.=''
lynes.0=0
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
startline=1
arg=bbspath'Information'
IF WORD(STATEF(arg),5)>lastondate THEN
DO
ADDRESS COMMAND 'C:LIST >'scratch'/dirlist' arg 'NOHEAD DATES SINCE' sincedate
IF WORD(STATEF(scratch'/dirlist'),2)>3 THEN
DO
lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
CALL readlines(scratch'/dirlist' startline+1)
END
END
arg=bbspath'Profiles'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
DO
ADDRESS COMMAND 'C:LIST >'scratch'/dirlist' arg 'NOHEAD DATES SINCE' sincedate
IF WORD(STATEF(scratch'/dirlist'),2)>3 THEN
DO
startline=lynes.0+2
lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
CALL readlines(scratch'/dirlist' startline+1)
END
END
arg=bbspath'rexxDoors/Data/Polls'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
DO
startline=lynes.0+2
lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
lynes.0=startline
END
IF logonflag=1 THEN nonstop=1
IF lynes.0>0 THEN CALL seelines(1)
nonstop=0
RETURN
chdir:
string=''
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO libs.0
SAY libs.i||CR
END
SAY pen3||LEFT('-',75,'-')||def||CR
dirnum=getinput(1 0 pen3'Select Library Number: 'def)
IF clr~='' THEN Send clr
IF ~DATATYPE(dirnum,'W') THEN
DO
waitchar=dirnum
RETURN 2
END
chdir2:
IF dirnum<1 | dirnum>99 THEN
DO
waitchar=dirnum
RETURN 1
END
IF dirs.dirnum='' THEN
DO
SAY pen3'That library number is currently un-assigned.'def||CR
RETURN 1
END
IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
DO
SAY pen3'You do not have authorization for that library!'def||CR
RETURN 1
END
td=libpath||dirs.dirnum
CALL MAKEDIR(td)
CALL setdir(td)
IF libtext=0 THEN
IF EXISTS(td'/.'STRIP(LEFT(dirs.dirnum,15))) THEN RETURN 0
t=libpath||plaindir'.txt'
IF terseflag | ~EXISTS(t) THEN RETURN 0
nonstop=1
SAY CR
CALL readlines(t 1)
CALL seelines(1)
SAY CR
nonstop=0
RETURN 0
since:
dm=DATE(,WORD(data.16,2),'S')
SAY CR
SAY 'New files or files moved since' dm||CR
CALL listsince()
CALL readlines(scratch'/dirlist' 1)
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN
listsince:
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
ADDRESS COMMAND 'C:list >'scratch'/dirlist' directory 'DATES SINCE' sincedate
RETURN
list:
onetime=0
IF DATATYPE(arg,'W') THEN onetime=1
ELSE arg=''
DO listloop=1
IF DATATYPE(arg,'W') THEN
DO
dirnum=arg
arg=''
IF chdir2()>0 THEN RETURN
CALL listsimple()
IF waitchar='Q' | onetime THEN LEAVE listloop
END
ELSE IF arg='' THEN
DO
libtext=0
IF chdir()>0 THEN
DO
libtext=1
RETURN
END
test='Y'
CALL showalpha2()
arg=''
IF waitchar='Q' THEN waitchar=''
IF waitchar~='' THEN RETURN
ITERATE listloop
END
ELSE RETURN
END
RETURN
listsimple:
ADDRESS COMMAND 'C:list >'scratch'/dirlist' directory 'DATES'
IF readlines(scratch'/dirlist' 1) THEN RETURN
IF lynes.0>3 THEN
DO
SAY pen3'Sorting...'def||lineup||CR
linesave=lynes.1 /* these 4 lines put in to leave dir title at top */
lynes.1='0'
IF lynes.0>1 THEN CALL QSORT(1,lynes.0-1,lynes)
CALL DELAY(14)
lynes.1=linesave
END
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN
browse:
curdironly=0
brdir=PRAGMA('D')
brfilenum=1
nonstop=0
IF files.0<1 THEN RETURN
lastfile=countcheck('Numbers/LastFile' 0)
IF lastfile<1 THEN RETURN
CALL postfour('Browse:' arg)
onearg=0
IF arg='' THEN
DO
lin='Browsing'
test=getinput(1 1 'Browse one library only? (Ny) > ')
IF test='Y' THEN
DO
IF chdir()>0 THEN RETURN
curdironly=1
lin=lin 'the' pen3||plaindir||def 'library'
t=libpath||plaindir'.txt'
IF edinfo(t,plaindir,'File Library') THEN RETURN
END
ELSE lin=lin 'all file libraries'
lin=lin 'backwards from latest file.'
SAY lin||CR
SAY CR
END
ELSE onearg=1
i=0
IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
DO lastfileloop=1
IF lastfile<1 THEN RETURN
arg=WORD(files.lastfile,2)
brfilenum=lastfile
IF WORD(files.lastfile,2)~='' THEN LEAVE lastfileloop
lastfile=lastfile-1
END
ELSE IF DATATYPE(arg,'W') THEN
DO
brfilenum=arg
arg=WORD(files.arg,2)
IF arg='' THEN
DO
SAY 'File number' brfilenum 'does not exist in the current libraries!'CR
RETURN
END
END
ELSE
DO
IF onearg THEN CALL busywait(4 1)
DO ni=lastfile TO 1 BY -1
IF onearg THEN CALL busywait(60 ni lastfile)
IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni
brfilenum=ni
CALL busywait(4 0)
LEAVE ni
END
IF ni<1 THEN
DO
SAY 'Unable to find a file description for' pen3||arg||def'.'CR
RETURN
END
END
IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
savearg=arg
IF brfilenum>lastfile THEN brfilenum=lastfile
newfilesdate=DATE('S') TIME()
DO browseloop=1
IF curdironly THEN CALL busywait(4 1)
DO ni=brfilenum TO 0 BY -1
IF ni=0 THEN LEAVE browseloop
IF files.ni='' THEN ITERATE ni
IF onearg THEN
DO
CALL busywait(60 ni lastfile)
IF UPPER(arg)~=UPPER(WORD(files.ni,2)) THEN ITERATE ni
IF (ni//30)>0 THEN CALL busywait(4 1)
LEAVE ni
END
testdir=UPPER(WORD(files.ni,1))
IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
DO
IF ni>lastbrowse THEN lastbrowse=ni
IF ni>0 THEN CALL busywait(60 ni lastfile)
ITERATE ni
END
IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
DO
IF ni>lastbrowse THEN lastbrowse=ni
ITERATE ni
END
LEAVE ni
END
IF curdironly | onearg THEN CALL busywait(4 0)
onearg=0
IF ni=0 THEN brfilenum=lastbrowse
ELSE brfilenum=ni
argname=WORD(files.brfilenum,2)
IF argname='' THEN RETURN
CALL setdir(libpath||WORD(files.brfilenum,1))
arg=bbspath'FileNotes/'plaindir'/'argname
CALL readlines(arg 1)
IF nonstop=1 THEN brostop=1
ELSE brostop=0
CALL seelines(1)
IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
CALL checktime()
IF brostop THEN
DO
SAY CR
nonstop=1
brfilenum=brfilenum-1
END
ELSE
DO
CALL postfour('Browse:' brfilenum plaindir'/'argname)
line=''
endtest=UPPER(RIGHT(argname,4))
IF FIND('.ARC .ARJ .DMS .LHA .LZH .LZX .RUN .ZIP .ZOO',endtest)>0 THEN
line='['pen3'C'def']ontents ['pen3'D'def']ownload'
ELSE line='['pen3'D'def']ownload'
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
line=line '['pen3'E'def']dit'
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
line=line '['pen3'K'def']ill'
IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
IF endtest='.TXT' | UPPER(argname)='.'UPPER(STRIP(LEFT(plaindir,15))) THEN
line=line '['pen3'R'def']ead'
line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
brcom=getinput(1 0 line)
IF DATATYPE(brcom,'W') THEN
DO
brfilenum=brcom+1
IF brfilenum>lastfile THEN brfilenum=lastfile+1
IF brfilenum<1 THEN brfilenum=1
SAY CR
END
ELSE brcom=LEFT(brcom,1)
CALL cleanline(0)
IF brcom='Q' THEN LEAVE browseloop
IF brcom='M' THEN
DO
wordnum=FIND(data.25,brfilenum)
IF wordnum=0 THEN
DO
data.25=STRIP(data.25 brfilenum)
SAY lineup||argname 'marked for next download.'CR
SAY CR
END
ELSE
DO
data.25=STRIP(DELWORD(data.25,wordnum,1))
SAY argname 'removed from download list.'CR
END
END
IF brcom='H' | brcom='?' THEN
DO
SAY pen3' - HELP with the Browse Files commands -'def||CR
SAY ' RETURN reads the next file description in line.'CR
SAY ' 34 will display the description of file number 34, if it exists.'CR
SAY ' C displays the contents of an archived (arc dms lzh lha zip zoo) file.'CR
SAY ' D displays the download menu.'CR
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
DO
SAY ' E puts this file description into the online Editor.'CR
SAY ' K deletes a file you uploaded. you cannot Kill others!'CR
END
IF level>sysoplevel THEN
SAY ' L move file and description to new Library and/or rename.'CR
SAY ' M mark/unmark the current file for the next download'CR
SAY ' N displays all descriptions without pausing. CTRL-E to Exit!'CR
SAY ' R displays file as text. - ONLY FILES THAT END IN .TXT -'CR
SAY ' Q returns to the main menu(s). (Quit)'CR
SAY CR
CALL waiting()
IF waitchar='Q' THEN LEAVE browseloop
END
ELSE IF brcom='L' & level>sysoplevel THEN
DO
curdir=PRAGMA('D')
IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
DO
newarg=getinput(0 0 'Rename' argname 'to ')
IF newarg~='' THEN
DO
IF is_here(newarg) THEN ITERATE browseloop
IF wi=999999 THEN ITERATE browseloop
IF EXISTS(libpath||filedir'/'newarg) THEN
DO
SAY CR
SAY '***' newarg 'already exists!'CR
SAY CR
ITERATE browseloop
END
junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
IF junk='Y' THEN
DO
lynes.2=OVERLAY(newarg,lynes.2,7,25)
comment=WORD(STATEF(arg),8)
CALL DELETE(arg)
arg=bbspath'FileNotes/'plaindir'/'newarg
CALL savelines(arg)
IF comment='' THEN
DO
mpath=libpath||plaindir
IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN
SAY 'Rename failed on main file!'CR
END
ELSE
DO
t=LASTPOS('/',comment)
IF t=0 THEN t=LASTPOS(':',comment)
mpath=LEFT(comment,t-1)
IF RENAME(comment,mpath'/'newarg)=1 THEN
ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg
ELSE SAY 'Rename failed on external file!'CR
END
files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
anum=files.brfilenum.0
alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
CALL send2log('RENAME:' argname 'to' newarg 'in' plaindir)
argname=newarg
sortalphaflag=1
savefileflag=1
CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15)))
END
END
END
IF getinput(1 1 'Move' argname '? (Ny) > ')='Y' THEN
DO
IF chdir()=0 THEN
DO
IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN
DO
CALL readlines(arg 1)
CALL movefile(brfilenum dirs.dirnum)
END
END
END
IF savefileflag>0 THEN CALL savefilelist()
CALL setdir(curdir)
END
ELSE IF brcom='N' THEN
DO
brfilenum=brfilenum-1
nonstop=1
SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR
SAY CR
CALL DELAY(99)
brcom=''
END
ELSE IF brcom='C' THEN
DO
temp=STRIP(WORD(STATEF(arg),8))
IF temp='' THEN temp=libpath||plaindir'/'argname
CALL Contents.rexx(temp)
IF EXISTS('RAM:CONTENTS') THEN
DO
CALL cleanline(1)
CALL showtext('RAM:CONTENTS' 0)
IF waitchar~='Q' THEN CALL waiting()
nonstop=0
END
ELSE SAY pen3'Not an archived file.'def||CR
END
ELSE IF brcom='D' THEN
DO
arg2=arg
arg=brfilenum
CALL dload()
arg=arg2
END
ELSE IF brcom='E' THEN
DO
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
DO
firstedit=5
IF level>sysoplevel THEN firstedit=1
CALL bbsEd.rexx(firstedit arg name TRUNC(maxtime-TIME('E'))-28)
CALL checkfilechanges()
END
END
ELSE IF brcom='K' THEN
DO
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
DO
IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
DO
tempnum=WORD(lynes.1,2)
IF tempnum=lastfile THEN
DO
CALL DELETE(bbspath'Numbers/LastFile')
CALL DELAY(28)
lastfile=lastfile-1
CALL countcheck('Numbers/LastFile' lastfile)
END
files.tempnum=''
tempnum2=files.tempnum.0
alpha.tempnum2='0 0' tempnum '100'
savefileflag=1
IF SHOW('P','BBBBS_LOCAL') THEN CALL savefilelist()
finfo=STATEF(arg)
IF WORDS(finfo)>7 THEN argname=WORD(finfo,8)
CALL DELETE(argname)
CALL DELETE(arg)
CALL send2log('Killed:' argname)
SAY argname pen3'has been deleted.'def||CR
CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15)))
END
END
END
ELSE IF brcom='R' & (endtest='.TXT' | UPPER(argname)='.'UPPER(STRIP(LEFT(plaindir,15)))) THEN
DO
vcount=WORD(lynes.2,7)+1
lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount
edtype=''
CALL savelines(arg)
CALL showtext(argname 1)
END
ELSE brfilenum=brfilenum-1
END
END
CALL setdir(brdir)
waitchar=''
IF nonstop THEN CALL waiting()
nonstop=0
CALL savedata(0)
RETURN
movefile:
PARSE ARG fnum movdir .
fromdir=STRIP(WORD(files.fnum,1))
farg=STRIP(WORD(files.fnum,2))
md=libpath||movdir
mf=md'/'farg
fd=libpath||fromdir
ff=fd'/'farg
CALL DELETE(md'/.'STRIP(LEFT(movdir,15)))
CALL DELETE(fd'/.'STRIP(LEFT(fromdir,15)))
fn=bbspath'FileNotes/'fromdir'/'farg
commen=WORD(STATEF(fn),8)
IF commen~='' THEN
DO
ff=commen
n=LASTPOS('/',ff)
IF n>1 THEN
DO
xf=SUBSTR(ff,n+1)
tfd=LEFT(ff,n-1)
n=LASTPOS('/',tfd)
IF n=0 THEN n=LASTPOS(':',tfd)
IF n>0 THEN
DO
tmd=LEFT(tfd,n)||movdir
SAY 'Rename external file'pen3 ff||def||CR
IF getinput(1 1 ' to'pen3 tmd'/'farg||def'? (Ny) > ')='Y' THEN
DO
fd=tfd
md=tmd
mf=md'/'farg
commen=md'/'xf
END
ELSE IF getinput(1 1 ' or move to'pen3 mf||def'? (Ny) > ')='Y' THEN
DO
fd=tfd
commen=''
END
END
END
END
CALL MAKEDIR(md)
IF RENAME(ff,mf)=0 THEN
DO
ADDRESS COMMAND 'C:COPY' ff mf
IF EXISTS(mf) THEN
IF DELETE(ff)~=1 THEN SAY pen3'Unable to delete'def ff||pen3'.'def||CR
END
files.fnum=movdir farg
lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
lynes.3=STRIP(lynes.3) movdir
CALL MAKEDIR(bbspath'FileNotes/'movdir)
mn=bbspath'FileNotes/'movdir'/'farg
CALL savelines(mn)
ndx=files.fnum.0
dnum=finddirnum(movdir)
alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
IF EXISTS(mn) THEN
DO
CALL DELETE(fn)
comm='C:FileNote' mn
IF commen~='' THEN comm=comm commen
ADDRESS COMMAND comm
END
savefileflag=1
line='Moved:' fromdir'/'farg 'to' movdir
CALL send2log(line)
SAY line||CR
RETURN
textsearch:
ARG sfile' 'sarg
IF sarg='' THEN RETURN 0
x=OPEN(f,sfile,'R')
IF x=0 THEN RETURN 0
stemp=UPPER(READCH(f,65000))
CALL CLOSE(f)
retflag=0
IF POS(sarg,stemp)>0 THEN retflag=1
DROP stemp
RETURN retflag
bbsSEARCH:
smenu=menu
test=UPPER(LEFT(arg,1))
IF test='F' THEN smenu='FILE'
IF test='M' THEN smenu='MSG'
IF test='U' THEN smenu='MAIN'
IF smenu='ALL' THEN
DO
junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
IF junk='F' THEN smenu='FILE'
ELSE IF junk='M' THEN smenu='MSG'
ELSE IF junk='U' THEN smenu='MAIN'
ELSE RETURN
END
IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN
searcharg=COMPRESS(searcharg,'*')
CALL send2log('SEARCH:' smenu 'for' searcharg)
IF smenu='NEW' | smenu='MAIN' THEN
DO
SAY 'Searching Userlist...'lineup||CR
CALL FileList(bbspath'Users/*'searcharg'*',sl)
SAY 'Found' sl.0 'matches 'CR
DO i=1 TO sl.0
SAY sl.i||CR
IF ~nonstop THEN
IF i//linesperpage=0 THEN
IF waiting2() THEN LEAVE i
END
DROP sl.
END
IF smenu='MSG' THEN
DO
CALL SETCLIP('BBSMSG_SEARCH',searcharg)
SAY lm
CALL bbsMsg.rexx(maxtime-TRUNC(TIME('E')) name password)
END
IF smenu='FILE' THEN
DO
lne=pen3'Searching'
curdironly=0
IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN
DO
IF chdir()>0 THEN RETURN
curdironly=1
lne=lne 'the'def plaindir pen3'library'
SAY CR
END
ELSE
DO
lne=lne 'all file libraries'
SAY CR
SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR
END
test=getinput(1 1 ' ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
IF test='Q' THEN RETURN
SAY CR
SAY lne 'for'def UPPER(searcharg)||CR
SAY pen3' - To ABORT, press CTRL-E -'def||CR
SAY CR
IF test~='F' THEN
DO
CALL fileheader()
IF curdironly=1 THEN
DO
af=libpath||dirs.dirnum'/.'STRIP(LEFT(dirs.dirnum,15))
IF EXISTS(af) THEN
DO
CALL readlines(af 1)
DO i=1 TO lynes.0
CALL busywait(8 i lynes.0)
tempnum=POS(UPPER(searcharg),UPPER(lynes.i))
IF tempnum>0 THEN
DO
CALL busywait(4 0)
SAY lynes.i||CR
SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
CALL busywait(4 1)
END
END
END
END
IF curdironly=0 | ~EXISTS(af) THEN
DO i=1 TO alpha.0
CALL busywait(60 i alpha.0)
ii=WORD(alpha.i,4)
IF ii>level THEN ITERATE i
IF curdironly=1 & ii~=dirnum THEN ITERATE i
ii=WORD(alpha.i,3)
IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
IF tempnum>0 THEN
DO
CALL busywait(4 0)
SAY alpha.i||CR
SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
CALL busywait(4 1)
END
END
END
ELSE
DO
cck=countcheck('Numbers/LastFile' 0)
nonstop=1
DO i=1 TO cck
IF i//50=0 THEN CALL checkdcd()
iii=cck+1-i
IF files.iii='' THEN ITERATE i
ii=files.iii.0
ii=WORD(alpha.ii,4)
IF ii>level THEN ITERATE i
IF curdironly=1 & ii~=dirnum THEN ITERATE i
IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
farg=WORD(files.iii,1)'/'WORD(files.iii,2)
SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)||CR
IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
DO
savei=i
CALL readlines(bbspath'FileNotes/'farg 1)
nonstop=1
CALL seelines(2)
i=savei
SAY CR
SAY CR
END
END
END
CALL busywait(4 0)
END
searcharg=''
nonstop=0
SAY CR
IF i<999999 THEN SAY lineup'All available items have been searched. 'CR
SAY CR
CALL waiting()
RETURN
finddirnum:
ARG fdirname .
DO fdir=1 TO 99
IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
END
RETURN 100
writebuffer:
PARSE ARG bufname .
Capture OFF
CALL DELETE(bufname)
SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
IF EXISTS(bufname) THEN
DO
CALL DELAY(56)
CALL DELETE(bufname)
CALL DELAY(56)
END
CaptWrap 74
Send pen3
Capture bufname
Send def
TimeOut 120
DO bufloop=1
Wait '/E,/S,RING,NO CARRIER'
Status 'L'
test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
CALL checkdcd()
IF test='/E' | test='/S' | test='/X' THEN LEAVE bufloop
END
IF test~='/X' THEN Send '\b\b'pen3
Capture OFF
CALL checkdcd()
TimeOut maxidle
SAY def||CR
startnum=lynes.0+1
CALL readlines(bufname startnum)
CALL wrapbuf(startnum)
QUEUE CR
RETURN
wrapbuf:
ARG startnum .
CALL cleanline(1)
SAY pen3'Wordwrapping...'def||CR
lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
lynes.startnum=cleanstring(2':'lynes.startnum)
DO wi=startnum WHILE wi<=lynes.0
wj=wi+1
lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
lynes.wj=cleanstring(2':'lynes.wj)
IF LENGTH(lynes.wi)>75 THEN
DO
testchar=''
IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
IF testchar=' ' | testchar='.' | testchar=':' THEN
DO
DO wjj=lynes.0 TO wi+1 BY -1
wk=wjj+1
lynes.wk=lynes.wjj
END
lynes.wj=''
lynes.0=lynes.0+1
END
DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
IF WORDS(lynes.wi)=1 THEN
lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
lynes.wj=WORD(lynes.wi,wl) lynes.wj
lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
END
END
END
RETURN
seelines:
ARG fancy .
DO i=1 TO lynes.0
IF fancy=0 THEN SAY lynes.i||def||CR
ELSE
DO
IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
SAY pen3||lynes.i||def||CR
ELSE SAY lynes.i||CR
IF fancy=2 & colorflag=1 THEN
DO
IF searcharg~='' THEN
DO
testpos=POS(UPPER(searcharg),UPPER(lynes.i))
IF testpos>0 THEN
SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def||CR
END
IF i=1 THEN
IF WORD(lynes.1,3)='Reply' THEN
DO
testpos=WORDINDEX(lynes.1,3)
SAY LEFT(' ',testpos-1)||pen3||lineup||SUBSTR(lynes.1,testpos)||def||CR
END
END
END
IF i//linesperpage=0 & i<lynes.0 THEN
IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN
readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
line=READLN(f)
IF EOF(f) THEN BREAK
lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0
savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
DO
ok=OPEN(f,tempname,'A')
IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
DO
line='***' tempname 'failed to open for saving!'
CALL send2log(line)
SAY line||CR
RETURN 1
END
DO wi=1 TO lynes.0
CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN 0
sortuserlist:
uf=bbspath'Lists/USERS'
IF sortuserflag THEN CALL DELETE(uf)
sortuserflag=0
IF ~EXISTS(uf) THEN
DO
users=bbsSortUsers.rexx(bbspath bbsname)
RETURN
END
ELSE
DO
IF OPEN(f,uf,'R')=0 THEN RETURN
users=0
DO i=1
dat=READCH(f,65000)
IF EOF(f) THEN LEAVE i
users=users+WORDS(dat)
END
CALL CLOSE(f)
END
SAY CENTER(RIGHT(users,8) 'Users on'pen3 bbsname,74)||def||CR
RETURN
showuserlist:
IF data.5='' THEN line='Here are the EMail names of the' users 'users on' bbsname '.'
ELSE line=' 'users 'users. Use these names to address messages.'
SAY pen3||line||def||CR
CALL showtext(bbspath'Lists/USERS' 1)
IF data.5~='' THEN CALL waiting()
RETURN
msgcount:
ARG countdir .
lastmess=0
totmsgs=0
unred=0
IF ~EXISTS(msgpath||countdir) THEN RETURN
IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
ELSE
DO
totmsgs=WORDS(SHOWDIR(msgpath||countdir))
msg.countdir.0=totmsgs
msg.countdir.1=STATEF(msgpath||countdir)
END
IF countdir>level | FIND(data.21,i)>0 THEN RETURN
lastread.countdir=WORD(data.22,countdir)
IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0
lastmess=countcheck('Numbers/LastMessage'countdir 0)
IF lastread.countdir<0 THEN RETURN
firstmess=countcheck('Numbers/FirstMessage'countdir 0)
IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
IF lastmess>0 THEN
IF lastread.countdir>=0 THEN
DO
IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
unred=lastmess-lastread.countdir
IF unred>totmsgs THEN unred=totmsgs
IF unred>0 | ~logonflag THEN
DO
cline=RIGHT(unred,5) 'new of' RIGHT(lastmess,5) 'messages,'
cline=cline RIGHT(totmsgs,5) 'still online in'
cline=cline RIGHT(countdir,2)',' msg.countdir
SAY pen6||cline||def||CR
END
END
RETURN
counts:
SAY CR
SAY 'Working...'CR
SAY CR
temp=''
DO i=1 TO 4
temp=temp||CENTER(copyright.i,75)||'0D0A'x
END
CALL SETCLIP('BBS_copyright',temp||CR)
CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 users)
SAY CR
CALL waiting2()
IF waitchar='Q' THEN RETURN
CALL showmarked(1)
CALL logonstats()
nonstop=0
CALL waiting()
RETURN
countmail:
SAY ' Counting online email...'lineup||CR
emailonline=0
t=SHOWDIR(bbspath'Users')
DO ti=1 TO WORDS(t)
emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(t,ti)))
END
SAY lineup' 'emailonline' letters online.'CR
RETURN
hourly:
IF level=99 & nonstop~=1 THEN
DO
IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
CALL cleanline(1)
END
SAY lm
CALL ShowHourly.rexx(name linesperpage colorflag nonstop)
RETURN
logonstats:
IF level=0 THEN RETURN
SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime||CR
tempnum=countcheck('Numbers/LastFile' 0)-lastbrowse
IF tempnum>files.0 THEN tempnum=files.0
line=RIGHT(countcheck('Numbers/LastFile' 0),5) 'uploaded,'
line=line RIGHT(files.0,5) 'files online.'CR
IF tempnum>0 THEN SAY RIGHT(tempnum,5) 'new of' line
ELSE SAY ' No new of' line
totmsg=0
grand=0
grand2=0
DO i=1 TO 99
IF msg.i='' THEN ITERATE i
CALL msgcount(i)
totmsg=totmsg+unred
grand=grand+totmsgs
grand2=grand2+lastmess
END
line=RIGHT(grand2,5) 'messages,' RIGHT(grand,5) 'still online.'||CR
IF totmsg>0 THEN SAY RIGHT(totmsg,5) 'new of' line
ELSE SAY ' No new of' line
callsleft:
test=WORD(data.11,9)
IF test<1 THEN
DO
IF DATE('S')=WORD(data.13,1) THEN
DO
line=pen0||bak1' Attention! 'def 'This is your last call for'
line=line DATE('W')',' DATE()
END
ELSE line='It''s after midnight here, you may call' WORD(data.11,5) 'more times today.'
END
ELSE
DO
line='You may call' test 'more time'
IF test~=1 THEN line=line's'
line=line 'today.'
END
SAY line||CR
RETURN
checkdcd:
IF GETCLIP('BBS_interpret')='' THEN
DO
dcd
IF RC=0 THEN
DO
DO dcds=1 TO 3 /* 5 second delay */
CALL DELAY(50)
dcd
IF RC~=0 THEN RETURN
END
dcd
IF RC=0 THEN
DO
SAY CR
Capture OFF
Remote OFF
CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^'
SAY line||CR
Send '\dATH1\r'
CALL send2log(line)
CALL sound('LOST')
IF newpassword='' THEN SIGNAL DONE
ELSE SIGNAL OUT
END
END
END
CALL checkexternal()
RETURN
sound:
ARG snd
IF bbsprefs.13=1 THEN RETURN
ADDRESS AREXX bbsSounds.rexx bbspath'Sounds/' snd
RETURN
checkexternal:
xmsg=GETCLIP('BBS_MESSAGE')
Capture
IF RC=0 & xmsg~='' & uldlflag=0 THEN
DO
SAY CR
SAY bak2' Message From BBBBS: 'def||CR
SAY xmsg||CR
SAY CR
CALL SETCLIP('BBS_MESSAGE')
CALL waiting()
END
xstring=GETCLIP('BBS_interpret')
IF xstring~='' THEN
DO
CALL SETCLIP('BBS_interpret')
INTERPRET xstring
END
xcom=GETCLIP('BBS_COMMAND')
IF xcom~='' THEN
DO
CALL SETCLIP('BBS_COMMAND')
IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2
IF opt~='' THEN
DO
IF POS('B',xcom)>0 THEN test='/X'
IF POS('L',xcom)>0 THEN CALL uplevel()
IF POS('M',xcom)>0 THEN CALL validate('DEF.MEMBER')
IF POS('R',xcom)>0 THEN CALL upratio()
IF POS('T',xcom)>0 THEN CALL uptime()
IF POS('V',xcom)>0 THEN CALL validate('DEF.CBV')
END
IF POS('C',xcom)>0 THEN CALL chat()
END
RETURN
chat:
chatrequest=0
chattime=TIME('E')
SAY 'Entering chat mode with sysop.'CR
MSG pen3'- Press backslash [\] to exit -'def
SAY 'Press [RETURN] twice to tell' sysop 'you are finished typing.'CR
SAY CR
OPTIONS PROMPT ''
string=''
DO WHILE(string~='\')
PULL string
CALL checkdcd()
END
addtime=addtime+(TIME('E')-chattime)%1
maxtime=maxtime+addtime
RETURN
readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for reading!'
SAY line||CR
CALL send2log(line)
RETURN 0
writeopen:
PARSE ARG fname
CALL CLOSE(f)
ok=OPEN(f,fname,'W')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for writing!'
SAY line||CR
CALL send2log(line)
RETURN 0
set_grand:
SAY 'Setting up public message conferences...'CR
grand=0
DO i=1 TO 99
IF msg.i='' THEN ITERATE i
msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
msg.i.1=STATEF(msgpath||i)
grand=grand+msg.i.0
END
RETURN
checkstats: /* clip is set and cleared by stats programs */
IF TIME('H')>3 & GETCLIP('BBS_STAT')='' THEN
DO
IF WORD(STATEF(bbspath'Logs/Numbers.dat'),5)<DATE('I') THEN
ADDRESS AREXX bbsNumbers.rexx
ELSE IF EXISTS(bbspath'Information/STATS.ULDL') THEN
DO
lfinfo=STATEF(bbspath'Information/STATS.ULDL')
IF WORD(lfinfo,5)<DATE('I') THEN
DO
ADDRESS AREXX bbsULDL.rexx
CALL DELAY(99)
END
END
IF TIME('H')>4 & EXISTS(bbspath'Information/STATS.USER') THEN
DO
ufinfo=STATEF(bbspath'Information/STATS.USER')
IF WORD(ufinfo,5)<DATE('I') THEN
DO
ADDRESS AREXX bbsUSER.rexx
CALL DELAY(99)
END
END
IF grand>SYSTEM_MSG_LIMIT & TIME('H')>5 & TIME('H')<9 THEN
DO
SAY 'Doing Message Conference Maintenence...'CR
Send 'ATH1\r'
CALL bbsMAINT.baud(SYSTEM_MSG_LIMIT sysop)
CALL set_grand()
Send 'ATZ\r'
END
END
RETURN
zerovars:
lastread.=0
totwrit.=0
data.=''
libs.=''
msgs.=''
clear_marked=0
sortalphaflag=0
loadalphaflag=0
savefileflag=0
sortuserflag=0
linesperpage=22
chatrequest=0
lastbrowse=0
buildalpha=0
uldlflag=0
terseflag=0
warnings=0
winnings=0
menuflag=0
nonstop=0
libtext=1
addtime=0
dirnum=1
msgdir=1
level=0
newfilesflag=0
newfilesdate=''
newpassword=''
replymsg=''
waitchar=''
string=''
name=''
city='?'
opt=''
clr=''
RETURN
SYNTAX:
FAILURE:
lin.1='
'ERRORTEXT(RC)'
'
lin.2=SIGL-1 SOURCELINE(SIGL-1)
lin.3=SIGL '
'SOURCELINE(SIGL)'
'
lin.4=SIGL+1 SOURCELINE(SIGL+1)
DO er=1 TO 4
IF level>sysoplevel THEN SAY lin.er||CR
CALL send2log(lin.er)
END
CALL CLOSE(f)
IF newpassword='' THEN SIGNAL DONE /* no user logged on, quit quietly */
SAY CR
CALL checkdcd()
waitchar=''
IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
SIGNAL RESTART
BREAK_E:
CALL CLOSE(f)
SAY pen3'*** CTRL-E BREAK ***'def||CR
waitchar=''
string=''
nonstop=0
rnonstop=0
brostop=0
i=999999
wi=999999
ui=999999
ni=-1
QUEUE CR
RETURN 0
HALT:
BREAK_C:
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E
CALL CLOSE(f)
IF newpassword='' THEN
DO
CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
SIGNAL DONE /* no user logged on, quit quietly */
END
CALL checkdcd()
SAY CR
IF warnings<1 THEN /* just 1 warning */
DO
warnings=warnings+1
SAY CR
SAY CR
SAY CR
SAY 'If you didn''t press CTRL-C then... HEY! Wake up!'CR
SAY ' Auto-disconnect in' TRUNC(maxidle/60+.5) 'minutes!'CR
SAY CR
SAY 'If you DID press CTRL-C, PLEASE use CTRL-E next time instead.'CR
SAY CR
Remote OFF
Send '^G\w^G\w^G^G^G^G'
Remote ON
waitchar=''
string=''
nonstop=0
CALL SETCLIP('BBS_door')
SIGNAL ON BREAK_C
CALL waiting()
SIGNAL RESTART
END
CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
SAY 'No Activity For' TRUNC(maxidle/30+.5) 'minutes! -- Disconnecting.'CR
Send '\d'
CALL sound('TIMEOUT')
SIGNAL OUT
LOGOUT:
junk=getinput(1 1 pen3'Leave Feedback for SysOp? (Ny) > 'def)
IF junk='Y' THEN
CALL editor(name maxtime-TRUNC(TIME('E')) 'MAIL' sysop . 0 0 'FEEDBACK')
LOGOUT2:
clr=''
CALL checkexternal()
SIGNAL OFF BREAK_E
CALL SETCLIP('BBS_level')
CALL callsleft()
secs=TIME('E')
mins=secs%60
secs=TRUNC(secs//60)
IF secs<10 THEN secs='0'secs
SAY CR
SAY 'Public files online: 'RIGHT(comma(files.0),9)||CR
SAY 'Public messages online: 'RIGHT(comma(grand),9)||CR
SAY CR
SAY 'Time used this call:' mins':'secs||CR
SAY 'Goodbye' name', thank you for calling' bbsname'.'CR
linesperpage=99
arg=bbspath'BBS_TEXT/GOODBYE'
IF EXISTS(arg) THEN
DO
CALL DELAY(14)
CALL showtext(arg 0)
END
SAY CR
IF bbsprefs.2 & ~terseflag THEN CALL doGrin()
OUT:
SIGNAL OFF BREAK_E
Remote OFF
data.18=winnings
line=left(name,16,' ') 'logged off at' time('C')
dcd
IF RC~=0 THEN Send '\ah'
IF data.20~='' THEN
DO
Status 'Y'
elapsed=RESULT
line=line 'Total:'elapsed
PARSE VAR elapsed thour':'tmin':'.
ADDRESS AREXX bbsHOURLY.rexx TIME('H') TIME('M')//60 thour tmin bbspath'Numbers/Hourly'
PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls .
IF ~DATATYPE(tmin,'W') THEN tmin=0
IF ~DATATYPE(thour,'W') THEN thour=0
IF ~DATATYPE(dhour,'W') THEN dhour=0
IF ~DATATYPE(dmin,'W') THEN dmin=0
IF ~DATATYPE(calls,'W') THEN calls=0
IF thour=0 & tmin<3 THEN /* free call if less than 3 minutes */
DO
wordloc=WORDINDEX(data.11,9)-1
wordval=WORD(data.11,9)+1
data.11=STRIP(LEFT(data.11,wordloc))
data.11=data.11 wordval 'more calls today'
END
ELSE IF thour>0 | tmin>(maxtime/120) THEN /* over 50% mins used */
CALL SETCLIP('BBS_FULLCALL',name TIME('M'))
ufile=LEFT(DATE('S'),6)
mmins=thour*60+tmin+countcheck('Usage/'ufile 0)
CALL countcheck('Usage/'ufile mmins)
mins=thour*60+tmin+countcheck('Numbers/Minutes' 0)
CALL countcheck('Numbers/Minutes' mins)
mins=thour*60+tmin+countcheck('Numbers/Minutes'bps 0)
CALL countcheck('Numbers/Minutes'bps mins)
cals=countcheck('Numbers/Calls' 0)+1
CALL countcheck('Numbers/Calls' cals)
cals=countcheck('Numbers/Calls'bps 0)+1
CALL countcheck('Numbers/Calls'bps cals)
thour=thour+dhour
tmin=tmin+dmin+1
IF tmin>59 THEN
DO
thour=thour+tmin%60
tmin=tmin//60
END
data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.'
CALL SETCLIP('BBS_totalusage',mmins%60 mmins//60)
CALL SETCLIP('BBS_userlogoff',TIME('C') DATE())
CALL postuser(6)
IF newfilesflag=1 THEN
DO
newfilesdate=DATE('S') TIME()
lastbrowse=countcheck('Numbers/LastFile' 0)
END
IF clear_marked=1 THEN data.24=''
CALL savedata(1)
data.5=''
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
DO
IF sortalphaflag>0 | savefileflag>0 THEN
CALL SETCLIP('BBS_QUICK_WAIT',1)
ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
END
arg=''
lastline=RIGHT(TIME('C'),7) LEFT(DATE(),6)
lastline=lastline' 'RIGHT(city,40)
lastline=OVERLAY(name,lastline,16,LENGTH(name)+1) RIGHT(bps,5)
lastline=lastline' Time:'elapsed
newpassword=''
IF data.20=0 THEN lastline=OVERLAY('UNVALIDATED_USER',lastline,16,38)
CALL send2last(lastline)
CALL bbsLOGOFF.baud(name level elapsed)
SAY lastline||def||CR
END
CALL sound('LOGOFF')
OUT2:
CALL send2log(line)
DONE:
CALL send2log('')
logonflag=0
colorflag=1
CALL colors(1)
DONE2:
CBVflag=0
CALL setdir(libpath||dirs.1)
CALL SETCLIP('BBS_maxtime')
CALL SETCLIP('BBS_winnings')
CALL SETCLIP('BBS_minutes')
CALL SETCLIP('BBS_level')
CALL SETCLIP('BBS_door')
Capture
IF RC~=0 THEN Capture OFF
Send '\c\ah'
IF WORDS(bbsprefs.27)=8 THEN CALL dimBBcols()
ELSE IF bbsprefs.27=1 THEN CALL ScreenToBack('BAUD')
ELSE IF bbsprefs.27=2 THEN Screen OFF
ELSE CALL DELAY(14)
Remote OFF
baud maxbps
IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 & loadalphaflag=0 THEN
CALL DELAY(128)
ELSE
DO
CALL ATZreset()
CALL DELAY(52)
Send 'ATH1\r'
CALL DELAY(128)
Send 'ATH1\r'
IF buildalpha~=0 THEN
DO
CALL BuildALPHA.rexx()
sortalphaflag=0
loadalphaflag=0
savefileflag=0
buildalpha=0
END
IF sortuserflag=1 THEN
DO
CALL sortuserlist()
IF SHOW('P','BBBBS_LOCAL') THEN
DO
CALL SETCLIP('BBS_localusers')
CALL SETCLIP('BBS_mainusers',1)
END
END
IF sortalphaflag>0 | savefileflag>0 | GETCLIP('BBS_resave')~='' THEN
DO
loadalphaflag=0
x=GETCLIP('BBS_resave')
IF savefileflag>0 THEN CALL savefilelist2()
ELSE IF x='' THEN CALL savealphalist()
x=GETCLIP('BBS_resave')
CALL SETCLIP('BBS_resave')
IF x=1 THEN
DO
sortalphaflag=1
savefileflag=1
SIGNAL DONE2
END
IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
CALL SETCLIP('BBS_QUICK_WAIT')
END
IF loadalphaflag=1 THEN CALL loadalpha(1)
IF emailonline<0 THEN CALL countmail()
END
IF bbsprefs.15=0 THEN /* quit or restart? */
DO
IF words(bbsprefs.27)=8 THEN CALL setBBcols()
CALL checkstats()
EXIT
END
IF STORAGE()<bbsprefs.15 THEN
DO
IF words(bbsprefs.27)=8 THEN CALL setBBcols()
SAY CR
SAY '*** Unsafe memory level!'CR
line='*** Less than' bbsprefs.15 'bytes available, BBBBS has been unloaded.'
SAY line||CR
SAY CR
CALL send2log(line)
EXIT
END
CALL CLOSE(f)
CALL CLOSE(log)
bad_atz=ATZreset() /* reset modem */
CALL zerovars()
DO FOREVER
IF GETCLIP('BBS_QUIT')='QUIT' THEN
DO
CALL SETCLIP('BBS_QUIT')
CALL SETCLIP('BBS_localfiles')
CALL SETCLIP('BBS_localusers')
Send '\c'
IF words(bbsprefs.27)=8 THEN CALL setBBcols()
IF SHOW('P','BBSPOST') THEN ADDRESS 'BBSPOST' 'QUIT'
EXIT
END
xstring=GETCLIP('BBS_RESET')
IF xstring~='' THEN SIGNAL RESET
xstring=GETCLIP('BBS_interpret')
IF xstring~='' THEN
DO
CALL SETCLIP('BBS_interpret')
INTERPRET xstring
SIGNAL DONE2
END
IF GETCLIP('BBS_localfiles')>1 THEN
DO
CALL DELAY(150)
Send 'ATH1\r'
CALL SETCLIP('BBS_localfiles')
CALL loadfiles()
CALL loadalpha(1)
SIGNAL DONE2
END
IF GETCLIP('BBS_localusers')~='' THEN
DO
CALL DELAY(150)
Send 'ATH1\r'
CALL SETCLIP('BBS_localusers')
sortuserflag=1
CALL sortuserlist()
SIGNAL DONE2
END
CALL checkemail()
IF bad_atz=1 THEN bad_atz=ATZreset()
dcd
IF RC~=0 THEN Send '\ah'
IF GETCLIP('BBS_SLAVE')=1 THEN
DO
Quiet ON
IF SHOW('P','BBS_SLAVE') THEN ADDRESS 'BBS_SLAVE' 'QUIT'
cm=''
t=WAITPKT('BBBBS')
DO i=1
p=GETPKT('BBBBS')
IF p='0000 0000'x THEN LEAVE i
cm=GETARG(p)
t=REPLY(p,0)
END
Quiet OFF
x=GETCLIP('BBS_SLAVE_RATE')
CALL SETCLIP('BBS_SLAVE_RATE')
IF cm='QUIT' THEN EXIT
SAY 'CONNECT' x||CR
SIGNAL LOGON
END
wres=''
Wait 'RING'
wres=RESULT
IF wres='RING' THEN
DO
Send 'ATA\r'
Timeout 45 /* wait 45 seconds for connect */
wres=''
Wait 'CONNECT,NO CARRIER,RING,+FCON,+FHNG'
wres=RESULT
CALL DELAY(28)
IF wres~='CONNECT' THEN SIGNAL DONE2
CALL DELAY(114)
SAY ' 'CR
CALL DELAY(28)
SAY ' 'CR
dcd
IF RC=0 THEN
DO
CALL DELAY(128)
dcd
IF RC=0 THEN
DO
CALL DELAY(128)
dcd
IF RC=0 THEN SIGNAL DONE2
END
END
CALL SETCLIP('BBS_interpret')
CALL SETCLIP('BBS_MESSAGE')
IF words(bbsprefs.27)=8 THEN CALL setBBcols()
ELSE IF bbsprefs.27=2 THEN Screen ON
ELSE CALL DELAY(114)
SAY ''CR /* reset text defaults */
SIGNAL LOGON
END
ELSE CALL checkstats()
IF GETCLIP('BBS_resave')~='' THEN SIGNAL DONE2
END
EXIT
dimBBcols:
DO i=0 TO 7
Send '\S'i'-'WORD('000 BA3 039 878 094 828 552 835',i+1)
END
RETURN
setBBcols:
DO i=0 TO 7
Send '\S'i'-'WORD(bbsprefs.27,i+1)
END
RETURN
ATZreset:
TimeOut 10
Send 'ATZ\r'
Wait 'OK,RING'
IF RESULT~='OK' THEN
DO
Send '\d\wATZ\r'
Wait 'OK'
IF RESULT~='OK' THEN
DO
Send '\w\w+++\w\w\w\wATH\r'
CALL sound('ATZ_FAIL')
IF WORDS(bbsprefs.27)=8 THEN CALL setBBcols()
ELSE IF bbsprefs.27=1 THEN CALL ScreenToFront('BAUD')
ELSE IF bbsprefs.27=2 THEN Screen ON
line='*** ATZ failed to reset!' TIME('C') DATE()
SAY line' Check your modem!!'CR
CALL send2log(line)
RETURN 1
END
END
TimeOut 45
Send '\dATH\r'
RETURN 0
getbaudrate: PROCEDURE
TRACE OFF
BaudRate
brate=RC
TRACE
RETURN brate
checkalias:
addressee=''
IF alias.0=0 THEN RETURN 0
DO i=1 TO alias.0
IF UPPER(alias.i)=UPPER(string) THEN
DO
addressee=realname.i
LEAVE i
END
END
IF addressee='' THEN RETURN 0
string=''
SAY pen3'Email to 'def||addressee||CR
CALL editor(name maxtime-TRUNC(TIME('E')) 'MAIL' addressee . 0 0)
RETURN 0
CBV:
IF bbsprefs.22=0 THEN RETURN
SAY CR
CALL showtext(bbspath'BBS_TEXT/CBV_INFO' 1)
SAY CR
IF bbsprefs.13~=1 THEN bbsprefs.13=0
CBVflag=bbsCallBack.baud(name colorflag bbsprefs.13 data.5)
x=GETCLIP('CALLBACK')
CALL SETCLIP('CALLBACK')
data.27=STRIP(data.27 x)
IF CBVflag~=0 THEN SIGNAL OUT
RETURN
/* BBBBS.baud */